Cargar celda con registro de la hoja que corresponda según se seleccione en otra celda.
Para Dante Amor
Hola:
Necesito que en la celda A13 se carguen los modelos correspondientes a la categoría que se haya elegido en la celda A3.
Te enviare mi archivo ya modificado.
1 respuesta
Respuesta de Dante Amor
1
Te anexo los códigos actualizados
Private Sub Worksheet_Change(ByVal Target As Range)
'Por.Dante Amor
Set h1 = ActiveSheet
Select Case Target.Address(False, False)
Case "A13": Set img = h1.Image1
Case "A27": Set img = h1.Image2
Case "A41": Set img = h1.Image3
Case "A55": Set img = h1.Image4
Case Else: Exit Sub
End Select
carp = [A3]
img.Picture = Nothing
Set h3 = Sheets(carp)
Set b = h3.Columns("A").Find(Target, LookAt:=xlWhole)
If Not b Is Nothing Then
ruta = ThisWorkbook.Path & "\IMAGENES\" & carp & "\"
arch = h3.Cells(b.Row, "B") & ".jpg"
If Dir(ruta & arch) <> "" Then
img.Picture = LoadPicture(ruta & arch)
Else
MsgBox "No existe el archivo"
End If
Else
MsgBox "No existe el modelo"
End If
End Sub
'
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
'Por.Dante Amor
If Target.Count > 3 Then Exit Sub
If Not Intersect(Target, Range("A13:C13")) Is Nothing Then
Application.ScreenUpdating = False
Set h1 = ActiveSheet
h1.Unprotect "Titanic"
hoja = Range("A3")
Set h2 = Sheets(hoja)
h2.Columns("A").Copy h1.Columns("Z")
u = h1.Range("Z" & Rows.Count).End(xlUp).Row
h1.Range("Z1:Z" & u).RemoveDuplicates Columns:=1, Header:=xlYes
'
u = h1.Range("Z" & Rows.Count).End(xlUp).Row
With Target.Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
xlBetween, Formula1:="=Z2:Z" & u
.IgnoreBlank = True
.InCellDropdown = True
.InputTitle = ""
.ErrorTitle = ""
.InputMessage = ""
.ErrorMessage = ""
.ShowInput = True
.ShowError = True
End With
h1.Protect "Titanic"
Application.ScreenUpdating = True
End If
End Subsal u dos
