Si se puede cambiar esta macro de Lista desplegable de imágenes, perfecta por...
Tengo esta macro de una lista desplegable:
Private Sub Worksheet_Activate()
' DANTE AMOR
On Error Resume Next
ActiveSheet.Unprotect Password:="1"
Application.ScreenUpdating = False
Me.Shapes("foto_del").Delete
Range("H1").Value = ""
Application.ScreenUpdating = True
ActiveSheet.Protect Password:="1"
End Sub
'
Private Sub Worksheet_Change(ByVal Target As Range)
' DANTE AMOR
If Not Intersect(Target, Range("H1")) Is Nothing Then
Application.ScreenUpdating = False
On Error Resume Next
ActiveSheet.Unprotect Password:="1"
Foto = Range("H1").Value & ".jpg"
ruta = ActiveWorkbook.Path & "\fotos\" & Foto
Me.Shapes("foto_del").Delete
Set fotografia = Me.Pictures.Insert(ruta)
With Range("H12:H38")
Arriba = .Top
Izquierda = .Left
Ancho = .Width
Alto = .Height
End With
With fotografia
.Name = "foto_del"
.Top = Arriba
.Left = Izquierda
.Width = Ancho
.Height = Alto
End With
Set fotografia = Nothing
Application.ScreenUpdating = True
ActiveSheet.Protect Password:="1"
End If
End Sub
Si se puede cambiar esta macro de Lista desplegable de imágenes, perfecta, por :
1º/ Cuando pongo la referencia de la foto en el :
Range("C12:C41").Select
2º/ Me salga la foto en el rango :
Range("H12:H38").Select
3º/ Que cuando escribo en la misma linea del :
Range("E12:E41").Select
4º/ Se borre la foto
Nota explicativa :
Range("C12:C41") es la referencia del articulo
Range("E12:E41") es la cantidad
Asi podria ver que lo que estoy facturando esta bien puesta la referencia
Si no se pude no te preocupes.
Otro saludo Dante
1 respuesta
Ya te lo he mandado ayer
Un saludo Dante
Te anexo la macro del evento change
Private Sub Worksheet_Change(ByVal Target As Range)
'Por.Dante Amor
If Not Intersect(Target, Range("C12:C41")) Is Nothing Then
Application.ScreenUpdating = False
On Error Resume Next
ActiveSheet.Unprotect Password:="1"
Foto = Target.Value & ".jpg"
ruta = ThisWorkbook.Path & "\fotos\" & Foto
Me.Shapes("foto_del").Delete
Set fotografia = Me.Pictures.Insert(ruta)
With Range("H12:H38")
Arriba = .Top
Izquierda = .Left
Ancho = .Width
Alto = .Height
End With
With fotografia
.Name = "foto_del"
.Top = Arriba
.Left = Izquierda
.Width = Ancho
.Height = Alto
End With
Set fotografia = Nothing
Application.ScreenUpdating = True
ActiveSheet.Protect Password:="1"
End If
'
If Not Intersect(Target, Range("E12:E41")) Is Nothing Then
Application.ScreenUpdating = False
On Error Resume Next
ActiveSheet.Unprotect Password:="1"
Me.Shapes("foto_del").Delete
Application.ScreenUpdating = True
ActiveSheet.Protect Password:="1"
End If
End Sub
'S aludos. Dante Amor. Recuerda valorar la respuesta. G racias
Impresionante, gracias Dante, valla libro excel de facturación que me esta quedando gracias a ti, que Dios te bendiga.
Un abrazo fuerte.
