Visual Basic para Aplicaciones - Ayuda con ListBox Excel-VBA

Option Explicit

Private Sub UserForm_Initialize()

Call load("*")

End Sub

Private Sub btnBuscar_Click()

Dim s$

s = VBA.Trim(txtBuscar.Text)

If s = "" Then Exit Sub

Call load("*" & VBA.UCase(s) & "*")

End Sub

Private Sub load(ByVal sPattern As String)

Dim v As Variant, col As New Collection

Dim i&, j&, t$

v = Hoja1.Range("tabla1")

For i = 1 To UBound(v, 1)

    t = ""

    For j = 1 To UBound(v, 2)

        If j = 2 And VBA.Trim(v(i, j)) = "" Then GoTo continue

        t = t & v(i, j) & "|"

    Next

    If VBA.UCase(t) Like sPattern Then

       col.Add t

    End If

Next

continue:

lb.Clear

For i = 1 To col.Count

    t = col.Item(i)

    With lb

        .AddItem

        .List(i - 1, 0) = VBA.Split(t, "|")(0)

        .List(i - 1, 1) = VBA.Split(t, "|")(1)

        .List(i - 1, 2) = VBA.Split(t, "|")(2)

        .List(i - 1, 3) = VBA.Split(t, "|")(3)

        .List(i - 1, 4) = VBA.Split(t, "|")(4)

        .List(i - 1, 5) = VBA.Split(t, "|")(5)

    End With

Next

End Sub

Option Explicit

Private Sub UserForm_Initialize()

On Error Resume Next

Call cargar("*")

End Sub

Private Sub btnBuscaron_Click()

Dim s$

s = VBA.Trim(txtBuscar.Text)

If s = "" Then Exit Sub

Call cargar("*" & VBA.UCase(s) & "*")

End Sub

Private Sub cargar(ByVal sPattern As String)

Dim v As Variant, col As New Collection

Dim i&, j&, t$

v = Hoja1.Range("BDMAQUINAS")

For i = 1 To UBound(v, 1)

    t = ""

    For j = 1 To UBound(v, 2)

        If j = 2 And VBA.Trim(v(i, j)) = "" Then GoTo continue

        t = t & v(i, j) & "|"

    Next

    If VBA.UCase(t) Like sPattern Then

       col.Add t

    End If

Next

continue:

ListBox1.Clear

For i = 1 To col.Count

    t = col.Item(i)

    With ListBox1

        .AddItem

        .List(i - 1, 0) = VBA.Split(t, "|")(0)

        .List(i - 1, 1) = VBA.Split(t, "|")(1)

        .List(i - 1, 2) = VBA.Split(t, "|")(2)

        .List(i - 1, 3) = VBA.Split(t, "|")(3)

        .List(i - 1, 4) = VBA.Split(t, "|")(4)

        .List(i - 1, 5) = VBA.Split(t, "|")(5)

        .List(i - 1, 6) = VBA.Split(t, "|")(6)

        .List(i - 1, 7) = VBA.Split(t, "|")(7)

        .List(i - 1, 8) = VBA.Split(t, "|")(8)

        .List(i - 1, 9) = VBA.Split(t, "|")(9)

        .List(i - 1, 10) = VBA.Split(t, "|")(10)

        .List(i - 1, 11) = VBA.Split(t, "|")(11)

        .List(i - 1, 12) = VBA.Split(t, "|")(12)

    End With

Next

End Sub

Sub Addcheckboxes()

Dim cell, LRow As Single

Dim chkbx As DropDown

Dim MyLeft, MyTop, MyHeight, MyWidth As Double

Application.ScreenUpdating = False

LRow = ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row

For cell = 2 To LRow

    If Cells(cell, "A").Value <> "" Then

        MyLeft = Cells(cell, "E").Left

        MyTop = Cells(cell, "E").Top

        MyHeight = Cells(cell, "E").Height

        MyWidth = Cells(cell, "E").Width

        ActiveSheet.DropDowns.Add(MyLeft, MyTop, MyWidth, MyHeight).Select

    End If

Next cell

Application.ScreenUpdating = True

End Sub

Sub RemoveCheckboxes()

'Dim chkbx As dropdowns

ActiveSheet.DropDowns.Delete

'For Each chkbx In ActiveSheet.CheckBoxes

'    chkbx.Delete

'Next

End Sub

Sub CopyRows()

For Each chkbx In ActiveSheet.DropDowns

    If chkbx.Value = 1 Then

        For r = 1 To Rows.Count

            If Cells(r, 1).Top = chkbx.Top Then

                With Worksheets("STSabado")

                    LRow = .Range("A" & Rows.Count).End(xlUp).Row + 1

                    .Range("A" & LRow & ":D" & LRow) = _

                    Worksheets("Seleccion").Range("A" & r & ":D" & r).Value

                End With

                Exit For

            End If

        Next r

    End If

Next

End Sub

Sub AddcheckboxesD()

Dim cell, LRow As Single

Dim chkbx As DropDown

Dim MyLeft, MyTop, MyHeight, MyWidth As Double

Application.ScreenUpdating = False

LRow = ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row

For cell = 2 To LRow

    If Cells(cell, "A").Value <> "" Then

        MyLeft = Cells(cell, "E").Left

        MyTop = Cells(cell, "E").Top

        MyHeight = Cells(cell, "E").Height

        MyWidth = Cells(cell, "E").Width

        ActiveSheet.DropDowns.Add(MyLeft, MyTop, MyWidth, MyHeight).Select

        With Selection

            .Caption = ""

            Worksheets("Hoja1").Range("A1").Value = 500

            .Display3DShading = False

        End With

    End If

Next cell

Application.ScreenUpdating = True

End Sub

Sub RemoveCheckboxesD()

'Dim chkbx As dropdown

ActiveSheet.DropDowns.Delete

'For Each chkbx In ActiveSheet.dropdowns

'    chkbx.Delete

'Next

End Sub

Sub CopyRowsD()

For Each chkbx In ActiveSheet.DropDowns

    If chkbx.Value = 1 Then

        For r = 1 To Rows.Count

            If Cells(r, 4).Top = chkbx.Top Then

                With Worksheets("STDomingo")

                    LRow = .Range("A" & Rows.Count).End(xlUp).Row + 1

                    .Range("A" & LRow & ":F") = _

                    Worksheets("Seleccion").Range("A" & r & ":D" & r).Value

                End With

                Exit For

            End If

        Next r

    End If

Next

End Sub