2 combobox y una imagen para visualizar
Tengo dos combobox y una imagen para visualizar solo que, ya pude hacer que los dos combobox muestren la información seleccionada pero lo que necesito es visualizar la imagen dependiendo de la información que le de al segundo combobox.
No se como adjuntar el archivo! Pero esta es la rutina!
'Cerrar el formulario
Private Sub CommandButton3_Click()
Unload Me
End Sub
Private Sub Image1_Click()
End Sub
Private Sub imgPicture_Click()
End Sub
'
'Al iniciar el formulario
Private Sub UserForm_Initialize()
End Sub
Private Sub UserForm_Activate()
Dim col As New Collection
Set hoja = Worksheets("Super")
ufila = hoja.Cells(hoja.Rows.Count, 1).End(xlUp).Row
On Error Resume Next
For i = 1 To ufila
col.Add Item:=hoja.Cells(i, 1).Value, Key:=CStr(hoja.Cells(i, 1).Value)
Next i
For i = 1 To col.Count
Me.ComboBox1.AddItem col(i)
Next i
Me.ComboBox2.Clear
End Sub
Private Sub ComboBox1_Change()
Me.ComboBox2.Clear
grupo = ComboBox1.Value
Set hoja = Worksheets("Super")
ufila = hoja.Cells(hoja.Rows.Count, 1).End(xlUp).Row
For i = 1 To ufila
dimension = Cells(i, 2)
If Cells(i, 1) = grupo Then
With Me.ComboBox2
.AddItem dimension
End With
End If
Next
End Sub
Private Sub ComboBox2_Change()
Me.Label1.Caption = ""
grupo = ComboBox1.Value
dimension = ComboBox2
Set hoja = Worksheets("Super")
ufila = hoja.Cells(hoja.Rows.Count, 1).End(xlUp).Row
For i = 1 To ufila
If Cells(i, 1) = grupo And Cells(i, 2) = dimension Then
Me.Label1.Caption = Cells(i, 3)
On Error Resume Next
Me.TextBox1 = Application.WorksheetFunction.VLookup(Me.ComboBox1.Value, _
Sheets("Super").Range("A1:G100"), 3, 0)
Me.TextBox2 = Application.WorksheetFunction.VLookup(Me.ComboBox1.Value, _
Sheets("Super").Range("A1:G100"), 4, 0)
Me.TextBox3 = Application.WorksheetFunction.VLookup(Me.ComboBox1.Value, _
Sheets("Super").Range("A1:G100"), 5, 0)
Me.TextBox4 = Application.WorksheetFunction.VLookup(Me.ComboBox1.Value, _
Sheets("Super").Range("A1:G100"), 6, 0)
Me.imgPicture.Picture = LoadPicture(Application.WorksheetFunction.VLookup(Me.ComboBox2.Value, _
Sheets("Super").Range("A1:G100"), 7, 0))
'cambia a formato pesonalizado
txtEditorial = Format(txtEditorial, "dd-mmm-yy")
On Error GoTo 0
End If
Next
End Sub
Te envío el archivo para que te des una idea.
1 Respuesta
H o l a : Sí, envíame tu archivo.
Mi correo [email protected]
En el asunto del correo escribe tu nombre de usuario “Karina Villarreal” y el título de esta pregunta.
Ya te envié el Archivo!!!! Muchas Gracias!!!!
Te anexo el código actualizado
Private Sub UserForm_Activate()
'
Dim col As New Collection
Set hoja = Worksheets("Super")
ufila = hoja.Cells(hoja.Rows.Count, 1).End(xlUp).Row
On Error Resume Next
For i = 2 To ufila
If hoja.Cells(i, "A") <> "" Then
col.Add Item:=hoja.Cells(i, 1).Value, Key:=CStr(hoja.Cells(i, 1).Value)
End If
Next i
For i = 1 To col.Count
Me.ComboBox1.AddItem col(i)
Next i
Me.ComboBox2.Clear
End Sub
'
Private Sub ComboBox1_Change()
Me.ComboBox2.Clear
TextBox5 = ""
TextBox6 = ""
TextBox7 = ""
TextBox8 = ""
grupo = ComboBox1.Value
Set hoja = Worksheets("Super")
ufila = hoja.Cells(hoja.Rows.Count, 1).End(xlUp).Row
For i = 1 To ufila
dimension = Cells(i, 2)
If hoja.Cells(i, 1) = grupo Then
ComboBox2.AddItem dimension
End If
Next
End Sub
'
Private Sub ComboBox2_Change()
'Me.Label1.Caption = ""
TextBox5 = ""
TextBox6 = ""
TextBox7 = ""
TextBox8 = ""
grupo = ComboBox1.Value
Me.imgPicture.Picture = Nothing
If ComboBox2 <> "" And IsDate(ComboBox2) Then
dimension = CDate(ComboBox2)
End If
Set hoja = Worksheets("Super")
ufila = hoja.Cells(hoja.Rows.Count, 1).End(xlUp).Row
For i = 2 To ufila
If hoja.Cells(i, 1) = grupo And hoja.Cells(i, 2) = dimension Then
'Me.Label1.Caption = hoja.Cells(i, 3)
TextBox5 = hoja.Cells(i, "C")
TextBox6 = hoja.Cells(i, "D")
TextBox7 = hoja.Cells(i, "E")
TextBox8 = hoja.Cells(i, "F")
arch = hoja.Cells(i, "G")
If Dir(arch) <> "" Then
'el archivo sí existe
Me.imgPicture.Picture = LoadPicture(arch)
End If
End If
Next
End Sub'S aludos. Dante Amor. Recuerda valorar la respuesta. G racias
