Error al cargar con VBA una imagen en un control activex
Buenas tardes,
Necesito ayuda con una macro, No tengo mucha idea de VBA pero buscando en internet suelo conseguir lo que quiero, el problema es que esta vez no entiendo porque no se me carga ninguna ima gen en los controles de imagen activex, tengo tres controles en los que debería cambiar la imagen en función del valor de una celda, pero no consigo que salga ninguna imagen en ninguno de ellos...
Muchas gracias por adelantado.
Este es el código que tengo:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Ruta As String
Dim foto As Variant
'defino la ruta de acceso a las fotos:
Ruta = "C:\Users\Rubu\Desktop\Imagenes Perfileria\"
'apago el parpadeo de pantalla:
Application.ScreenUpdating = False
'por las dudas, controlo cualquier posible error:
On Error Resume Next
'Si elegimos la foto pero antes ya teníamos otra, antes de insertar, borramos la anterior
With Sheets(1)
If Not IsEmpty(.Image1.Picture) Then
.Image1.Picture = Nothing
End If
If Not IsEmpty(.Image2.Picture) Then
.Image2.Picture = Nothing
End If
If Not IsEmpty(.Image3.Picture) Then
.Image3.Picture = Nothing
End If
foto = Range("h9").Value
ActiveSheet.Image1.Picture = LoadPicture(Ruta & foto & ".JPEG")
.Image1.PictureSizeMode = fmPictureSizeModeStretch
foto2 = Range("h16").Value
ActiveSheet.Image2.Picture = LoadPicture(Ruta & foto2 & ".JPEG")
.Image2.PictureSizeMode = fmPictureSizeModeStretch
foto3 = Range("h24").Value
ActiveSheet.Image3.Picture = LoadPicture(Ruta & foto3 & ".JPEG")
.Image3.PictureSizeMode = fmPictureSizeModeStretch
End With
End Sub
1 respuesta
En lo posible no utilices On Error Resume Next
Prueba con lo siguiente:
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("H9, H16, H24")) Is Nothing Then
'defino la ruta de acceso a las fotos:
Ruta = "C:\Users\Rubu\Desktop\Imagenes Perfileria\"
With ActiveSheet
.Image1.Picture = Nothing
.Image2.Picture = Nothing
.Image3.Picture = Nothing
foto1 = .Range("h9").Value & ".JPEG"
foto2 = .Range("h16").Value & ".JPEG"
foto3 = .Range("h24").Value & ".JPEG"
If Dir(Ruta & foto1) <> "" Then
.Image1.Picture = LoadPicture(Ruta & foto1)
.Image1.PictureSizeMode = fmPictureSizeModeStretch
End If
If Dir(Ruta & foto2) <> "" Then
.Image2.Picture = LoadPicture(Ruta & foto2)
.Image2.PictureSizeMode = fmPictureSizeModeStretch
End If
If Dir(Ruta & foto3) <> "" Then
.Image3.Picture = LoadPicture(Ruta & foto3)
.Image3.PictureSizeMode = fmPictureSizeModeStretch
End If
End With
End If
End Sub.
'S aludos. Dante Amor. Recuerda valorar la respuesta. G racias
.
Avísame cualquier duda
.
Mil Gracias!! ya funciona! solo me queda una duda mas, el valor de las celdas H9 y h24 en realidad es un concatenado de otras dos celdas y al cambiar el valor de una de las celdas que forma el concatenado, la foto no cambia automáticamente, tengo que seleccionar H9 (por ejemplo) y enter entonces si cambia la foto.
Gracias y un saludo,
Ana
Escribe en la siguiente línea las celdas involucradas, por ejemplo:
If Not Intersect(Target, Range("H9, H10, H16, H17, H24, H25")) Is Nothing Then.
'S aludos. Dante Amor. Recuerda valorar la respuesta.
