Mostrar imagenes asociadas a una celda

05/10/2011 - 21:03 por J Romero | Informe spam
Buenas,

Como puedo modificar esta macro que hace lo siguiente:

En la Celda C4 se muestra un desplegable con las opciones a escoger,
al escoger la opción requerida inmediatamente en el rango de "B6:D21"
se muestra la foto.


Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
If Target.Cells = Range("C4") Then
Application.ScreenUpdating = False
foto = Range("C4").Value
foto = Replace(foto, " ", "-")
foto = foto & ".jpg"
rutayarchivo = ActiveWorkbook.Path & "\" & foto
Me.Shapes("foto").Delete
Set fotografia = Me.Pictures.Insert(rutayarchivo)
With Range("B6:D21")
Arriba = .Top
Izquierda = .Left
Ancho = .Offset(0, .Columns.Count).Left - .Left
Alto = .Offset(.Rows.Count, 0).Top - .Top
End With
With fotografia
.Name = "foto"
.Top = Arriba
.Left = Izquierda
.Width = Ancho
.Height = Alto
End With
Set fotografia = Nothing
Application.ScreenUpdating = True
End If
End Sub



Como se puede modificar la macro para que me muestre de la siguiente
forma:

no lo quiero en lista desplegable, quiero tener la lista en las celdas
de la Columna C, a partir digamos de la Celda C10, y que al momento de
hacer click en la Celda C10 aparezca la foto en pantalla que hace
referencia a ese "codigo o palabra" escrito en dicha celda, y si hago
click en la C15 de igual forma, aparezca la foto en pantalla que hace
referencia a dicha celda.


Saludos,

Johann
 

Leer las respuestas

#1 J Romero
06/10/2011 - 00:14 | Informe spam
On 5 oct, 14:03, J Romero wrote:
Buenas,

Como puedo modificar esta macro que hace lo siguiente:

En la Celda C4 se muestra un desplegable con las opciones a escoger,
al escoger la opción requerida inmediatamente en el rango de "B6:D21"
se muestra la foto.

Private Sub Worksheet_Change(ByVal Target As Range)
    On Error Resume Next
    If Target.Cells = Range("C4") Then
        Application.ScreenUpdating = False
        foto = Range("C4").Value
        foto = Replace(foto, " ", "-")
        foto = foto & ".jpg"
        rutayarchivo = ActiveWorkbook.Path & "\" & foto
        Me.Shapes("foto").Delete
        Set fotografia = Me.Pictures.Insert(rutayarchivo)
        With Range("B6:D21")
            Arriba = .Top
            Izquierda = .Left
            Ancho = .Offset(0, .Columns.Count).Left - .Left
            Alto = .Offset(.Rows.Count, 0).Top - .Top
        End With
        With fotografia
            .Name = "foto"
            .Top = Arriba
            .Left = Izquierda
            .Width = Ancho
            .Height = Alto
            End With
        Set fotografia = Nothing
        Application.ScreenUpdating = True
    End If
End Sub

Como se puede modificar la macro para que me muestre de la siguiente
forma:

no lo quiero en lista desplegable, quiero tener la lista en las celdas
de la Columna C, a partir digamos de la Celda C10, y que al momento de
hacer click en la Celda C10 aparezca la foto en pantalla que hace
referencia a ese "codigo o palabra" escrito en dicha celda, y si hago
click en la C15 de igual forma, aparezca la foto en pantalla que hace
referencia a dicha celda.

Saludos,

Johann





Aca tengo otro Codigo Adicional:

Este codigo si hace lo que necesito pero me obliga a que la celda
contenga toda la ruta de la imagen incluido la extension "C:\imgs
\foto1.jpg" , y al momento de hacer click en cualquier celda que
contenga la ruta completa, inmediatamente aparece la imagen, pero como
puedo cambiar este código para que solo en la celda tenga el nombre de
la foto, es decir "foto1" y que aparezca la foto inmediatamente.

Aca les paso el codigo, espero me puedan ayudar,

Gracias



Private Sub Worksheet_SelectionChange(ByVal Target As Range)
On Error Resume Next
If Dir(Target.Value) = "" Or Err <> 0 Then
ActiveSheet.Shapes("Foto").Delete
Exit Sub
End If
Dim f As Object
Application.ScreenUpdating = False
With ActiveSheet
.Shapes("Foto").Delete
Set f = .Pictures.Insert(Target.Value) '//Target.Value contiene C:\imgs
\foto1.jpg
With f '//Dimensiones de la foto
.Name = "Foto"
.Left = Target.Left + Target.Width
.Top = Target.Top
.Width = 250
.Height = 250
End With
End With
Set f = Nothing
Application.ScreenUpdating = True
End Sub

Preguntas similares