¿Como inserter una imagen mediante un botón vba?

Private Sub CommandButton1_Click()

Dim fname As String

    fname = Application.GetOpenFilename(filefilter:= _

            "Bitmap Files(*.jpg),*.jpg", Title:="Select Image To Open") 'SOLO ABRE IMAGENES JPG, PERO PUEDES AÑADIR MAS FORMATOS

    If fname <> "False" The

        Image1.Picture = LoadPicture(fname)

        Me.Repaint

    End If

End Sub

Pulsando sobre el botón se abre un cuadro de dialogo donde se selecciona una imagen y se coloca dentro del recuadro Image1.

Necesitas un botón y un cuadro imagen

Puedes poner algo así:

Private Sub CommandButton1_Click()
Dim abririmagen As Office.FileDialog
Set abririmagen = Application.FileDialog(msoFileDialogFilePicker)
With abririmagen
    .AllowMultiSelect = False
    .Title = "Selecciona imagen"
    . Filters. Clear
    . Filters.Add "JPG", "*.JPG"
    . Filters. Add "JPEG File Interchange Format", "*.JPEG"
    . Filters. Add "Graphics Interchange Format", "*.GIF"
    . Filters.Add "Portable Network Graphics", "*.PNG"
    . Filters.Add "Tag Image File Format", "*.TIFF"
    .Filters.Add "All Pictures", "*.*"
    If .Show = -1 Then
    ActiveSheet.Pictures.Insert (.SelectedItems(1))
    End If
End With
End Sub

Al dar click en el botón te abre una ventana para insertar y luego la inserta directamente a la hoja activa.

Suerte

Daniel Espino Muchas gracias por el aporte, de entrada cumple la función que requiero (Insertar una imagen en X celda de la hoja), lo cual ES EXCELENTE!
¿Habría manera de definir que fuese siempre en la K2, dado que será insertado un renglón cada vez que se haga un registro nuevo desde el formulario.
Desde ya muchisimas gracias por el apoyo a mi humilde proyecto. Saludos!

Solo tendrías que seleccionar la celda, usa esta:

Private Sub CommandButton1_Click()
Dim abririmagen As Office.FileDialog
Set abririmagen = Application.FileDialog(msoFileDialogFilePicker)
ActiveSheet.Cells(2, 11).Activate
With abririmagen
    .AllowMultiSelect = False
    .Title = "Selecciona imagen"
    . Filters. Clear
    . Filters.Add "JPG", "*.JPG"
    . Filters. Add "JPEG File Interchange Format", "*.JPEG"
    . Filters. Add "Graphics Interchange Format", "*.GIF"
    . Filters.Add "Portable Network Graphics", "*.PNG"
    . Filters.Add "Tag Image File Format", "*.TIFF"
    .Filters.Add "All Pictures", "*.*"
    If .Show = -1 Then
    ActiveSheet.Pictures.Insert (.SelectedItems(1))
    End If
End With
End Sub

Daniel Espino Una disculpa por no haberme reportado antes debido a auditorias en mi trabajo. Te agradezco infinitamente el apoyo ya quedó perfecto.

Daniel Espino Buenas tardes:
¿Habrá manera de que la imagen insertada desde el formulario tuviera una dimension especifica de 2.30cm por 2.30cm?
De antemano agradezco la gran ayuda que me haz dado.

Daniel Espino Las imágenes se insertan en el documento de excel perfectamente. sin embargo he creado un archivo en Word con el cual combina correspondencia de la BDD creada en excel. La cual se muestra de la siguiente manera:

Aqui no se visualizan =(

El código vba uilizado para cargar la imagen funciona excelente, el cual es el siguiente:

---------------------------------------------------

Private Sub Image1_Click()

Dim abririmagen As Office.FileDialog
Set abririmagen = Application.FileDialog(msoFileDialogFilePicker)
ActiveSheet.Cells(2, 10).Activate
With abririmagen
    .AllowMultiSelect = False
    .Title = "Selecciona imagen"
    .Filters.Clear
    .Filters.Add "JPG", "*.JPG"
    .Filters.Add "JPEG File Interchange Format", "*.JPEG"
    .Filters.Add "Graphics Interchange Format", "*.GIF"
    .Filters.Add "Portable Network Graphics", "*.PNG"
    .Filters.Add "Tag Image File Format", "*.TIFF"
    .Filters.Add "All Pictures", "*.*"
    If .Show = -1 Then
    ActiveSheet.Pictures.Insert (.SelectedItems(1))
    End If
End With

----------------------------------------

Nota: Las imagines insertadas en las celdas no se visualizan en el documento de word, a continuación les maestro el ejemplo:

De antemano agradezco el apoyo a este humilde proyecto. Saludos!

No pasa nada no siempre tenemos tiempo, yo también he estado muy ocupado.

Para el tamaño solo necesitas agregar estas 2 lineas y unos cuantos arreglos.

Quedaría algo así

Private Sub CommandButton1_Click()
Dim abririmagen As Office.FileDialog
Dim img As Object
Set abririmagen = Application.FileDialog(msoFileDialogFilePicker)
ActiveSheet.Cells(2, 11).Activate
With abririmagen
    .AllowMultiSelect = False
    .Title = "Selecciona imagen"
    . Filters. Clear
    . Filters.Add "JPG", "*.JPG"
    . Filters. Add "JPEG File Interchange Format", "*.JPEG"
    . Filters. Add "Graphics Interchange Format", "*.GIF"
    . Filters.Add "Portable Network Graphics", "*.PNG"
    . Filters.Add "Tag Image File Format", "*.TIFF"
    .Filters.Add "All Pictures", "*.*"
    If .Show = -1 Then
    Set img = ActiveSheet.Pictures.Insert(.SelectedItems(1))
    img.Width = 300
    img.Height = 300
    End If
End With
End Sub

Solo le cambias las medidas por las que necesites.

Respecto a lo de word no se como lo pases pero al copiar a word solo te copia las celdas mas no los objetos (de hecho ni se seleccionan) y creo que no es posible seleccionar imágenes y objetos al mismo tiempo.
Por ultimo respecto al formulario, jamás lo mencionaste, y también requieren de instrucciones para que carguen.

Puedes usarlo con la instrucción:

Image1.Picture = LoadPicture (la ruta de tu imagen)

Daniel Espino Buenas tardes:
De Nuevo agradeciendo tu gran ayuda en este humilde proecto. Ha quedado resuelto el tema de las medidas, va perfecto con la modificación.
Sobre el tema del enlace de Excel a Word, se lleva a cabo mediante la combinación de correspondencia. Esto permite que los datos ingresados en cada uno de los registros de nuestra BDD, se ingresen en el document de Word en los campos correspondientes.

Quedo en espera de tus comentarios.

Igual si me proporcionas tu correo, puedo mandarte ambos archivos para que veas como funcionan y ver la posibilidad de lograr la transferencia de imagines dentro de la BDD.

Muchas gracias. =D

Intenta otra vez con este arreglo:

Private Sub CommandButton1_Click()
Dim abririmagen As Office.FileDialog
Dim img As Object
Set abririmagen = Application.FileDialog(msoFileDialogFilePicker)
ActiveSheet.Cells(2, 11).Activate
With abririmagen
    .AllowMultiSelect = False
    .Title = "Selecciona imagen"
    . Filters. Clear
    . Filters.Add "JPG", "*.JPG"
    . Filters. Add "JPEG File Interchange Format", "*.JPEG"
    . Filters. Add "Graphics Interchange Format", "*.GIF"
    . Filters.Add "Portable Network Graphics", "*.PNG"
    . Filters.Add "Tag Image File Format", "*.TIFF"
    .Filters.Add "All Pictures", "*.*"
    If .Show = -1 Then
    Set img = ActiveSheet.Pictures.Insert(.SelectedItems(1))
    img.Width = 50
    img.Height = 50
    img.Placement = xlMoveAndSize
    img.PrintObject = True
    End If
End With
End Sub

Cabe recalcar que la celda K2 debe tener exactamente el mismo tamaño que la imagen a insertar.
Con esto (creo) ya debería de poder pasar.
En caso contrario mi correo es [email protected]
Lo revisamos.