Configuracion de Macro con Litsbox , ComboBox y Piture
publicado
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
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
For Each vNum2 In ValorUnico2
Me.B_T_Grafica.AddItem vNum2
Next vNum2
End Sub
Featured Replies
Archivado
Este tema está ahora archivado y está cerrado a más respuestas.
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
Next
'On Error Resume Next
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
For Each vNum2 In ValorUnico2
Me.B_T_Grafica.AddItem vNum2
Next vNum2
End Sub