Excel - Desplegar imagenes

   
Vista:

Desplegar imagenes

Publicado por Gabriel (15 intervenciones) el 30/10/2007 00:23:36
Hola a todos. Estoy trabajando con imagenes dentro de una hoja tengo 5 opciones a elegir. De estas 5 opciones puedo escoger 1 , 2 o bien todas las opciones, el problema que tengo es que al seleccionar ya sea dos a mas opciones quisiera desplegar esas dos o mas imagenes correspondientes a cada opcion,ya supe en este foro como desplegar imagenes por medio de de una lista desplegable, pero solo funciona para una sola seleccion ;ya que si pongo las 5 listas que necesito solo me funciona la primera la demas no funcionan, no se si algo este haciendo mal , no me marca ningun error el VB pero pues no funciona les dejo el codigo para que me ayuden a ver que esta mal o si es la manera correcta como lo estoy haciendo, si es mejor con IF o CASE o como seria mejor.Muchas Gracias Y Saludos.

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Fotos, Foto, Foto As Object, Arriba As Double, Izquierda As Double, Ancho As Double, Alto As Double
Dim ruta As String
Application.ScreenUpdating = False
On Error Resume Next

Select Case Fotos
Case Foto
If Not Target = [o25] Then Exit Sub
Me.Shapes("Foto").Delete
ruta = ThisWorkbook.Path & "\" & [o25] & ".png"
Set Foto = Me.Pictures.Insert(ruta)
With Range("r25:s32")
Arriba = .Top
Izquierda = .Left
Ancho = .Offset(0, .Columns.Count).Left - .Left
Alto = .Offset(.Rows.Count, 0).Top - .Top
End With
With Foto
.Name = "Foto"
.Top = Arriba
.Left = Izquierda
.Width = Ancho
.Height = Alto
End With
Set Foto = Nothing
Application.ScreenUpdating = True

Case Foto1
If Not Target = [h96] Then Exit Sub
Me.Shapes("Foto1").Delete
ruta1 = ThisWorkbook.Path & "\" & [h96] & ".png"
Set Foto1 = Me.Pictures.Insert(ruta)
With Range("r95:s103")
Arriba = .Top
Izquierda = .Left
Ancho = .Offset(0, .Columns.Count).Left - .Left
Alto = .Offset(.Rows.Count, 0).Top - .Top
End With
With Foto1
.Name = "Foto1"
.Top = Arriba
.Left = Izquierda
.Width = Ancho
.Height = Alto
End With
Set Foto1 = Nothing
Application.ScreenUpdating = True

End Select
End Sub
Valora esta pregunta
Me gusta: Está pregunta es útil y esta claraNo me gusta: Está pregunta no esta clara o no es útil
0
Responder