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
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
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
Gracias Dante Amor por tu aporte, estoy utilizando tu código de arriba para insertar una imagen y esta excelente, tengo una duda, necesito insertar varias imágenes en la misma hoja en diferentes celdas, cada una con un botón de insertar imagen, que adecuaciones necesito en el código? espero y me puedas ayudar, muchas gracias por tu esfuerzo y dedicación. - Jackass Smith
Si vas a crear un botón para cada imagen, entonces en esta línea de la macro: imagen = "D2" , tienes que cambiar el D2 por la celda donde vas a poner la imagen. - Dante Amor
Y cada macro lo pongo en un modulo independiente? tengo que insertar 28 imagenes diferentes en la misma hoja! Gracias por tu aportación, espero y me puedas ayudar! - Jackass Smith
Otra duda, Se podra agregar una ruta para seleccionar las fotos y que se visualicen desde ahi, esto para que el archivo no pese demasiado? - Jackass Smith
Sí, tienes que crear un módulo y una macro por cada botón. - Dante Amor
Sí es posible visualizar la imagen. Crea una nueva pregunta para entender bien cuál resultado quieres. - Dante Amor
Listo Dante ya abrí una nueva pregunta! Insertar imagen desde ruta con macros en diferentes celdas de una hoja de excel, espero y me pudieses ayudar! Gracias de antemano. - Jackass Smith