Adaptar código

Hola Elsamatilde.
Consultando las respuestas que has facilitado a otros inexpertos como yo (bueno, yo el que más) he visto un código que me gustó, el cual podría resultarme útil con un pequeño cambio. ¿Lo qué hace el mismo es que al presionar una celda determinada de la columna? ¿A? Se muestra una imagen.
Mi problema es que esa imagen se muestra justo encima de la celda presionada.
¿Se podría representar, esa imagen, en un sitio de la hoja que yo decida, ejemplo en la celda? ¿G10?
También, ¿Podría hacerlo mediante una VALIDACIÓN DE DATOS CON CRITERIO DE LISTA?
El Código al que hago referencia es:
Private Sub Worksheet_selectionChange(ByVal Target As Excel.Range)
If Target.Column = 1 Then
ActiveSheet.Pictures.Delete
Select Case Target.Value
Case 1
ActiveSheet.Pictures.Insert(ThisWorkbook.Path & "\1111.jpg").Select
Case 2
ActiveSheet.Pictures.Insert(ThisWorkbook.Path & "\2222.jpg").Select
End Select
End If
End Sub
Si consideras que en la presente consulta pudieran estar incluidas dos preguntas gustosamente te las formularé por separado.
Un saludo.

1 respuesta

Respuesta
1
Esta rutina está adaptada al modelo de lista validada, que supuse en el ejemplo en A15
La idea es que obtenga primero los extremos superior e izquierdo de las celdas que necesites para ubicar la imagen 'por encima'
Private Sub Worksheet_Change(ByVal Target As Excel.Range)
'rutina que inserta imágenes en ubicaciones predeterminadas
Dim izq, tope As Single
'se controla el cambio en la celda con lista validada
If Target.Address(False, False) = "A15" Then
'opcional: borrar imágenes anteriores
ActiveSheet.Pictures.Delete
Select Case Target.Value
'los case serán por cada valor de la lista
Case 1
ActiveSheet.Pictures.Insert(ThisWorkbook.Path & "\home.gif").Select
'se obtiene la ubicación de la celda G10
tope = Range("G10").Top
izq = Range("G10").Left
'se ubica la imagen sobre la celda G10
Selection.ShapeRange.Top = tope
Selection.ShapeRange.Left = izq
Case 2
ActiveSheet.Pictures.Insert(ThisWorkbook.Path & "\blkc1.gif").Select
'se obtiene la ubicación de la celda E15
tope = Range("E15").Top
izq = Range("E15").Left
Selection.ShapeRange.Top = tope
Selection.ShapeRange.Left = izq
End Select
End If
End Sub
Ya van las modificaciones en la próxima consulta, (acabo de verla)
Saludos
Elsa
PD) Esta rutina y 300 más podrás encontrar en mi manual '300Macros'. Descarga la demo gratis desde http://es.geocities.com/lacibelesdepunilla/manual

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas