Aprendemos Código VBA extendido a varias imágenes
¡Saludos!
Tengo un problema con un código, y ya que no sé programar en VBA me encuentro totalmente parado. El código es este:
Private Sub Worksheet_Change(ByVal Target As Range)
'Si hay errores, que continúe
On Error Resume Next
'Si cambiamos el dato de la celda X, mostramos la foto de ese Clan
If Target.Cells = Range("E24") Then
'Ocultamos el procedimiento
Application.ScreenUpdating = False
'Pasamos a una variable, el nombre de la foto,
'que será el mismo que el nombre del Clan
imagen = Range("E24").Value
'Añadimos la extensión "png"
imagen = imagen & ".png"
'Buscamos la foto en el mismo directorio
'donde tenemos este fichero de Excel
ruta = ActiveWorkbook.Path & "\clanes\" & imagen
'Borramos la foto del Clan (si hubiera alguna)
Me.Shapes("imagen_clan").Delete
'Creamos el objeto fotografia, con la foto insertada
Set clan = Me.Pictures.Insert(ruta)
'Haremos que la foto ocupe desde X hasta X,
'para que no salgan fotos supergrandes, o
'superpequeñas, y salgan más "normalitas"
With Range("Z9:AH25")
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 "clan"
'para poder borrarlo cuando cambie la celda X
'(Ver que borramos la foto que hubiese, antes de insertar la nueva)
With clan
.Name = "imagen_clan"
.Top = Arriba
.Left = Izquierda
.Width = Ancho
.Height = Alto
End With
'Eliminamos el objeto
Set clan = Nothing
'Ponemos todo como estaba
Application.ScreenUpdating = True
End If
End SubEl código funciona perfectamente, pero quiero modificarlo según dos posibles ideas (cualquiera de las dos me valdría)
1- ¿Se puede 'extender' este código para que coja el valor de 3 celdas en lugar de 1, y ponga 3 imágenes en lugar de 1?
2- En caso de que lo anterior no pueda hacerse, ¿existe algún modo para 'repetir' este código en la misma hoja sin que me salte un error de compilación o algo así?
Muchas gracias por las molestias =)
1 Respuesta
1. A qué te refieres con "extender", ¿quieres modificar una de 3 celdas y que te ponga 3 imágenes al mismo tiempo? ¿O quieres modificar una de 3 celdas y cargar la imagen según lo que pusiste en la celda?
2. ¿Y por qué dices que te salta un error de compilación?
Tienes que decirme también cuáles serían esas 3 celdas y en cuál celda quieres cada imagen
Saludos. Dante Amor
Vale, voy a intentar explicarme mejor. Se me han ocurrido dos posibles soluciones:
1- El código que puse coge el valor de la celda E24 y según lo que ponga en esa celda pone una imagen asociada. Bien. Lo que me gustaría es que este código cogiera el valor de la celda E24, y también los valores de la celdas H50 y K77, y que pusiera 3 imágenes diferentes, una por cada valor de las celdas claro. Además me gustaría poder ubicarlas correctamente por separado.
Ó, segunda opción
2- Si lo de arriba no pudiera hacerse, la idea sería repetir el mismo código dos veces en la misma hoja. Así tendría un código como el que he puesto para la E24, otro casi idéntico para la H50 y un tercero casi idéntico para la K77. Así podría modificar el rango en que se muestra la imagen, el lugar donde están las imágenes, etc., por separado.
Siento que no se me haya entendido bien antes, como soy muy novato en VB y apenas sé hacer nada me cuesta explicarme. Perdón por las molestias Dante Amor =)
Un saludo y muchas gracias
No me dijiste en qué celdas quieres cada imagen. La siguiente macro es para la opción1.
Private Sub Worksheet_Change(ByVal Target As Range)
'Mod.Por.DAM
On Error Resume Next
If Not Intersect(Target, Range("E24, H50, K77")) Is Nothing Then
imagen = Target & ".png"
ruta = ActiveWorkbook.Path & "\clanes\" & imagen
Select Case Target.Address(False, False)
Case "E24"
rango = "Z24:AH39"
numimg = "imagen1"
Case "H50"
rango = "Z50:AH65"
numimg = "imagen2"
Case "K77"
rango = "Z77:AH92"
numimg = "imagen3"
End Select
Me.Shapes(numimg).Delete
Set clan = Me.Pictures.Insert(ruta)
With Range(rango)
Arriba = .Top
Izquierda = .Left
Ancho = .Offset(0, .Columns.Count).Left - .Left
Alto = .Offset(.Rows.Count, 0).Top - .Top
End With
With clan
.Name = numimg
.Top = Arriba
.Left = Izquierda
.Width = Ancho
.Height = Alto
End With
Set clan = Nothing
Application.ScreenUpdating = True
End If
End SubRealiza los siguientes cambios en la macro de acuerdo a tus necesidades.
En esta parte tienes que poner las celdas en donde vas a poner los nombres, actualmente tiene las celdas E24, H50 y K77.
If Not Intersect(Target, Range("E24, H50, K77")) Is Nothing ThenY en esta parte tienes que poner las celdas destino en donde quieres las imágenes
Select Case Target.Address(False, False)
Case "E24"
rango = "Z24:AH39"
numimg = "imagen1"
Case "H50"
rango = "Z50:AH65"
numimg = "imagen2"
Case "K77"
rango = "Z77:AH92"
numimg = "imagen3"
End SelectSaludos.Dante Amor
No olvides finalizar la pregunta.
P.D.
Ya tenía lista la macro cuando hiciste la primer pregunta. Cuando quise contestarla, ya la había tomado el "experto" "Gabri_Garcia". Y vaya respuesta que te puso, ni yo le entendí. Si no van a contestar la pregunta no deberían tomarla.
