Macro para Insertar una Imagen en una celda desde un boton.

Tengo un archivo de excel, alli tengo un boton1 (Sin formulario) y quiero saber si existe alguna macro que al darle click al boton1 me abra la opción de insertar imagen para que el usuario escoja la foto y la inserte en la hoja y además en me aparezca la ruta que seleccionó en la celda A32.

2 Respuestas

Respuesta
2

Al principio de la macro puedes poner en cuál celda quieres la ruta y en cuál celda quieres la imagen, cambia las celdas que quieres en estas líneas de la macro:

ruta = "A32" 'celda en donde se pondrá la ruta
imagen = "D2" 'celda en donde se pondrá la imagen

Sub insertarimagen()
'Por.DAM
    ruta = "A32" 'celda en donde se pondrá la ruta
    imagen = "D2" 'celda en donde se pondrá la imagen
    Application.ScreenUpdating = False
    With Application.FileDialog(msoFileDialogFilePicker)
        .Title = "Seleccione archivo de imagen"
        .Filters.Clear
        .Filters.Add "Todos los archivos", "*.*"
        .Filters.Add "*.jpg", "*.jpg"
        .Filters.Add "*.bmp", "*.bmp"
        .FilterIndex = 2
        .AllowMultiSelect = False
        .InitialFileName = ThisWorkbook.Path
        '.Show
        If .Show Then
            archivo = .SelectedItems.Item(1)
            pos = InStrRev(archivo, "\")
            wruta = Left(archivo, pos)
            ActiveSheet.Pictures.Insert(archivo).Select
            arr = Range(imagen).Top
            izq = Range(imagen).Left
            hei = Range(imagen).Offset(1, 0).Top - arr
            wid = Range(imagen).Offset(0, 1).Left - izq
            With Selection
                .Placement = xlMoveAndSize
                .PrintObject = True
                .ShapeRange.LockAspectRatio = msoFalse
                .ShapeRange.Top = arr
                .ShapeRange.Left = izq
                .ShapeRange.Height = hei
                .ShapeRange.Width = wid
                .ShapeRange.Name = archivo
            End With
            Range("D2").ShrinkToFit = True
        End If
    End With
    Application.ScreenUpdating = True
End Sub
Respuesta
1

Adjudica esta macro a tu botón

Sub proceso()
'por luismondelo
Application.Dialogs(xlDialogInsertPicture).Show
End Sub

Te mando otra macro que hace lo que necesitas. En la celda A32 tenemos anotado la ruta deseada. Y la foto la insertará en la celda H5 (estas dos celdas las puedes cambiar en la macro)

Sub imagen()
'por luismondelo
ruta = Range("a32").Value
ChDir ruta
tope = Range("h5").Top
izq = Range("h5").Left
vfile = Application.GetOpenFilename("Archivos (*.jpg;*.bmp),*.jpg;*.bmp")
If vfile = False Then Exit Sub
ActiveSheet.Pictures.Insert(vfile).Select
Selection.ShapeRange.Top = tope
Selection.ShapeRange.Left = izq
Selection.ShapeRange.Height = 127
End Sub

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas