Insertar imágenes con vb
A ver si consigo explicarme. Excel 2003.
He encontrado esto:
Private Sub Worksheet_Change(ByVal Target As Range)
'Si ha errores, que continúe
On Error Resume Next
'Si cambiamos el dato de la celda C4,
'mostramos la foto de ese vehículo
If Target.Cells = Range("C4") Then
'Ocultamos el procedimiento
Application.ScreenUpdating = False
'pasamos a una variable, el nombre de la foto,
'que será el mismo que el nombre del coche, pero
'separado con guiones, y sin acentos, para que
'todos los usuarios puedan verlo correctamente
foto = Range("C4").Value
'en la foto, reemplazamos los espacios, por guiones
foto = Replace(foto, " ", "-")
'ahora le añadimos la extensión "jpg"
foto = foto & ".jpg"
'ahora buscamos la foto en el mismo directorio
'donde tenemos este fichero de excel
rutayarchivo = ActiveWorkbook.Path & "\" & foto
'borramos la foto del coche (si hubiera alguna)
Me.Shapes("foto_del_coche").Delete
'creamos el objeto fotografía, con la foto insertada
Set fotografía = Me.Pictures.Insert(rutayarchivo)
'haremos que la foto ocupe desde B6 hasta D21,
'para que no salgan fotos supergrandes, o
'superpequeñas, y salgan más "normalitas"
With Range("B6:D21")
Arriba = .Top
Izquierda = .Left
Ancho = .Offset(0, .Columns.Count).Left - .Left
Alto = .Offset(.Rows.Count, 0).Top - .Top
End With
'le ponemos un nombre al objeto "fotografía"
'para poder borrarla cuando cambie la celda D6
'(ver que borramos la foto que hubiese, antes de insertar la nueva)
With fotografía
.Name = "foto_del_coche"
.Top = Arriba
.Left = Izquierda
.Width = Ancho
.Height = Alto
End With
'eliminamos el objeto
Set fotografía = Nothing
'ponemos todo como estaba
Application.ScreenUpdating = True
End If
End Sub
Pero, con esto solo consigo una imagen por consulta.
¿Cómo tendría que hacer para crear un catálogo con mas imágenes en diferentes celdas?
He intentado hacer modificaciones pero no consigo que se mantengan las imágenes, cuando pongo otra en la celda contigua, se me borra la anterior.
Supongo que habrá que crear como un bucle, (copiar y pegar tantas veces como imágenes desee, pero como en Vb estoy pez, no se desde donde hasta donde.