EXCEL insertar imagenes automaticamente segun referencia
Att. Sr. Amor.
He estado mirando por la web y no soy capaz de ver lo que necesito y como en la otra ocasión me ayudo tantísimo con la macro que me preparó, me he permitido escribirle directamente.
Igual puede ayudarme con esto. Que creo que debe de ser sencillo pero no soy capaz de hacerlo.
Habitualmente genero listas de precios de productos en excel con multitud de referencias y generalmente en la primera columna, añado una celda con la imagen de cada producto.
Hasta la fecha lo que hago es insertar las imágenes una a una pero las tengo todas en una carpeta de mi equipo.
Me pregunto si existiría la manera de poder hacer que se insertasen automáticamente en función a la segunda columna donde aparece el código de cada una de las referencias.
Inserto un pequeño ejemplo.
Me gustaría saber si es posible hacer que la imagen se inserte automáticamente relacionándose con el código de la segunda columna y teniéndola guardada en una carpeta en el equipo.
1 respuesta
H o l a:
Envíame tu archivo de excel con 2 archivos de imágenes, me dices en cuál celda se debe insertar cada una de esas 2 imágenes.
Cómo quieres hacer el proceso, que al ejecutar la macro borre todas las imágenes y cargue nuevamente todas las que se encuentren en la carpeta, de esa forma tendrías actualizada toda la hoja.
Mi correo [email protected]
En el asunto del correo escribe tu nombre de usuario “Enrique Garcia” y el título de esta pregunta.
H o l a:
Te anexo la macro
Sub InsertarImagenes()
'Por.Dante Amor
Application.ScreenUpdating = False
ActiveSheet.DrawingObjects.Delete
u = Range("A" & Rows.Count).End(xlUp).Row
Rows("1:" & u).RowHeight = 60
Columns("B:B").ColumnWidth = 15
ruta = ThisWorkbook.Path & "\imagenes\"
For i = 1 To u
arch = Dir(ruta & Cells(i, "A") & ".*")
If arch <> "" Then
With Cells(i, "B")
Arriba = .Top + 1
Izquierda = .Left + 1
Ancho = .Width - 2
Alto = .Height - 2
End With
'
Set fotografia = ActiveSheet.Pictures.Insert(ruta & arch)
With fotografia
.Placement = xlMoveAndSize
.ShapeRange.LockAspectRatio = msoFalse
.Top = Arriba
.Left = Izquierda
.Width = Ancho
.Height = Alto
End With
Set fotografia = Nothing
End If
Next
Application.ScreenUpdating = True
MsgBox "Imágenes insertadas"
End Sub':) 'S aludos. D a n t e A m o r . R ecuerda valorar la respuesta. G racias ':)
