Configuracion de Macro con Litsbox , ComboBox y Piture

lluismanuell · el 10 de septiembre

Hola,

me pueden ayudar con lo seguiente, estoy desarrollando un proyecto en el cual consiste en cargar un comboxBox con lo datos almacenados en una celda y agregarlo a un listbox tambien que al seleccionar un item en el listbox se cargue la imagen enlazada a un cuadro de imagen.

el codigo del formulario es el siguiente.

Private Sub CommandButton2_Click()
B_Filtro.Hide
Sheets("Portal").Select

End Sub

Private Sub CommandButton3_Click()
Vision.Show
End Sub

Private Sub CommandButton4_Click()

B_Filtro.Hide
B_Filtro.Show

End Sub

Private Sub display_Click()

On Error Resume Next
Set a = Sheets("BD")
uf = a.Range("B" & Rows.Count).End(xlUp).Row
fila = 5
r = ("B" & fila & ":B" & uf)
busco = (display.List(display.ListIndex, 0))
Set codigo = a.Range(r).Find(busco, LookIn:=xlValues, LookAt:=xlWhole)
dire = codigo.Row
Path = ThisWorkbook.Path & "\Imagenes\" & Sheets("BD").Cells(dire, "G")
filtro = Sheets("BD").Cells(dire, "D")
filtro2 = Sheets("BD").Cells(dire, "E")
filtro3 = Sheets("BD").Cells(dire, "F")
filtro4 = Sheets("BD").Cells(dire, "C")
filtro5 = Sheets("BD").Cells(dire, "B")
mostrar.Picture = LoadPicture(Path)
Vision.V_m_detectado.Value = filtro
Vision.V_ma_detectado.Value = filtro2
Vision.v_cierre.Value = filtro3
Vision.v_fecha.Caption = filtro4
Vision.v_t_grafica.Caption = filtro5

End Sub

Private Sub F_Buscar_Click()

filtro = Sheet7.Range("C" & Rows.Count).End(xlUp).Row
filtro2 = Sheet7.Range("B" & Rows.Count).End(xlUp).Row
display = Clear
display.RowSource = Clear

Y = 0

For fila = 5 To filtro
fecha2 = Sheet7.Cells(fila, 3).Value
grafica = Sheet7.Cells(fila, 2).Value

If fecha2 Like "*" & Me.B_Fecha.Value & "*" And grafica Like "*" & Me.B_T_Grafica.Value & "*" Then

Me.display.AddItem
Me.display.List(Y, 0) = Sheet7.Cells(fila, 1).Value
Me.display.List(Y, 1) = Sheet7.Cells(fila, 2).Value
Me.display.List(Y, 2) = Sheet7.Cells(fila, 3).Value
Me.display.List(Y, 3) = Sheet7.Cells(fila, 4).Value
Me.display.List(Y, 4) = Sheet7.Cells(fila, 5).Value
Me.display.List(Y, 5) = Sheet7.Cells(fila, 6).Value
Me.display.List(Y, 6) = Sheet7.Cells(fila, 7).Value
Y = Y + 1

End If

End Sub

Private Sub UserForm_Activate()

Dim fila As Long
Application.DisplayAlerts = False
Application.ScreenUpdating = False

Set b = Sheets("BD")

uf = b.Range("A" & Rows.Count).End(xlUp).Row
uc = b.Cells(5, Columns.Count).End(xlToLeft).Address

wc = Mid(uc, InStr(uc, "$") + 1, InStr(2, uc, "$") - 2)

Sheets("BD").Select

With display
.ColumnCount = 5
.ColumnWidths = "250 pt;180 pt;180 pt"
.RowSource = "B5:G" & uf

End With

Application.DisplayAlerts = True
Application.ScreenUpdating = True

End Sub

Private Sub UserForm_Initialize()

Dim ValorUnico As Collection
Dim rng As Range
Dim cell As Range
Dim sh As Worksheet
Dim vNum As Variant
Dim ValorUnico2 As Collection
Dim rng2 As Range
Dim cell2 As Range
Dim sh2 As Worksheet
Dim vNum2 As Variant

Set sh = ThisWorkbook.Worksheets("BD")
Set rng = sh.Range("C5", sh.Range("C5").End(xlDown))

Set ValorUnico = New Collection

On Error Resume Next
For Each cell In rng.Cells
ValorUnico.Add cell.Value, CStr(cell.Value)

Next cell

On Error GoTo 0

For Each vNum In ValorUnico
Me.B_Fecha.AddItem vNum

Next vNum

Set sh2 = ThisWorkbook.Worksheets("BD")
Set rng2 = sh.Range("B5", sh.Range("B5").End(xlDown))

Set ValorUnico2 = New Collection

On Error Resume Next
For Each cell In rng2.Cells
ValorUnico2.Add cell.Value, CStr(cell.Value)

Next cell

On Error GoTo 0