Cambiar imagen según valor de celdas

Buen día
Me ayudas a cambiar una imagen según el valor de una celda... Quiero cambiar varias imágenes en una sola hoja, use este código pero solo cambia una imagen, aparte de la celda F3, también cambie seguen la celda G3
Private Sub Worksheet_Change(ByVal Target As Range)
''***********' para poner logotopos
'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("F3") 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("F3").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
rutayarchivo = "D:\Analisis\SISTEMA INTEGRA\Imagenes\" & foto
'borramos la foto del coche (si hubiera alguna)
Me.Shapes("foto_del_coche").Delete
'creamos el objeto fotografia, con la foto insertada
Set fotografia = 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")
With Range("J6:K8")
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 "fotografia"
'para poder borrarla cuando cambie la celda D6
'(ver que borramos la foto que hubiese, antes de insertar la nueva)
With fotografia
.Name = "foto_del_coche"
.Top = Arriba
.Left = Izquierda
.Width = Ancho
.Height = Alto
End With
'eliminamos el objeto
Set fotografia = Nothing
'ponemos todo como estaba
Application.ScreenUpdating = True
End If
End Sub

1 Respuesta

Respuesta
1
Con este cambio debería funcionar lo que necesitas
Private Sub Worksheet_Change(ByVal Target As Range)
''***********' para poner logotopos
'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("F3,G3") Then

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas