macro para insertar imágenes a cada producto de una lista

[capitanesteban]

Hola a todos, tengo una lista gigante de modelos de productos en excel la cual quiero insertar a cada modelo su respectiva imagen mediante una macro, es decir, en la columna B tengo una infinidad de modelos de productos y en la columna A quiero que se inserte la imagen correspondiente de cada uno de esos modelos, ejemplo:

[TABLE=width: 500]

[TR]

[TD=align: center]A[/TD]

[TD=align: center]B[/TD]

[TD][/TD]

[/TR]

[TR]

[TD]imagen del modelo[/TD]

[TD]modelo[/TD]

[TD][/TD]

[/TR]

[TR]

[TD][/TD]

[TD]AA0001[/TD]

[TD][/TD]

[/TR]

[TR]

[TD][/TD]

[TD]BB0002[/TD]

[TD][/TD]

[/TR]

[TR]

[TD][/TD]

[TD]CC0003[/TD]

[TD][/TD]

[/TR]

[TR]

[TD][/TD]

[TD]DD0004[/TD]

[TD][/TD]

[/TR]

[TR]

[TD][/TD]

[TD]EE0005[/TD]

[TD][/TD]

[/TR]

[TR]

[TD][/TD]

[TD]FF0006[/TD]

[TD][/TD]

[/TR]

[/TABLE]

Las imágenes están en una carpeta aparte y el nombre de la imagen.jpg es igual al nombre del modelo del producto.

Les solicito su apoyo para poder tener una macro o que me envíen de favor el código fuente para poder hacer la macro.

Muchas gracias.

lista de productos.xls

[Invitado Gengis Khan]

Hola:

Le adjunto dos macros, una, inserta las imágenes, la otra, las borra.

Las imágenes se adaptan de forma automática al tamaño de la celda de la columna A.

Le aconsejo guardar el archivo sin las imágenes.

Debe sustituir el directorio de las imágenes por el suyo.

'=========================================

Sub BorrarImágenes()

For Each imagen In ActiveSheet.Shapes

   If Left(imagen.Name, 2) = "@@" Then imagen.Delete

Next


End Sub


'=========================================

Sub InsertarImágenes(): On Error Resume Next

Application.ScreenUpdating = False

Range("B6").Select

Do Until ActiveCell = ""

   ActiveSheet.Shapes("@@" & ActiveCell.Address(False, False)).Delete

   ActiveSheet.Pictures.Insert _

              ([COLOR=#008000][B]ThisWorkbook.Path[/B][/COLOR] & "\" & ActiveCell & ".jpg").Select

   With Selection.ShapeRange

     .Name = "@@" & ActiveCell.Address(False, False)

     .LockAspectRatio = False                  'Permite modificar la imagen

     .Top = ActiveCell.Offset(, -1).Top        'Distancia al borde superior

     .Left = ActiveCell.Offset(, -1).Left      'Distancia al borde izquierdo

     .Height = ActiveCell.Offset(, -1).Height  'Alto de la imagen

     .Width = ActiveCell.Offset(, -1).Width    'Ancho de la imagen

   End With

   ActiveCell.Offset(1, 0).Select

Loop

End Sub

'=========================================


[/CODE]

Saludos

[capitanesteban]

Mi amigo, te agradezco muchísimo, me sirvió bastante la macro, gracias y hasta pronto.

[aTos666]

Hola tengo un trabajo muy parecido, el problema es que mi conocimiento de VBA es practicamente nulo.

En el CODIGO que has creado has puesto que "Debe sustituir el directorio de las imágenes por el suyo". ¿Donde tengo que colocar el directorio?

Un saludo y gracias

[Antoni]

El directorio está resaltado en color verde dentro del código VBA.

[Sergiomoragomez]

Señores Buenas tardes,

Es la primer vez que accedo a un foro a solicitar ayuda por sugerencia de un amigo, actualmente estoy usando la correspondencia para transferir datos tabulados en excel a un formato especifico en word, eso ha sido de gran ayuda porque genero 100 documentos en cuestión de minutos, el problema es que ahora quiero pasar fotos, pero no tengo idea como hacerlo, actualmente copio el URL en el excel y la transfiero a word, posteriormente busco la foto y la inserto, lo que me hace demasiado tedioso el trabajo, se que alguno de ustedes me puede colaborar con alguna forma de insertar varias imágenes de una carpeta en escritorio a un formato word en lugares específicos.

Saludos

Sergio