Jump to content
Fórum Script Brasil
  • 1

criação de filtro em um list box


Question

bom dia estou tentando criar um formulario de pesquisa com list box mais um filtro no text box, mas estou tendo dificuldades.

image.thumb.png.99497fc744a8e4d9fe719f9e6fbc6b80.pngimage.thumb.png.66d1a0ab41cbed4378853f7b8875f452.pngimage.thumb.png.d3cbfadbf8fda41514b62ca4f420a15c.png

"""
Option Explicit

Dim lo As ListObject
Private planilha As String
Private tabela As String
Private TextoDigitado As String

Private Sub btncarrega_Click()
   If cbpesquisa.Value = "Cidadão" Then
                planilha = "Cidadão"
                tabela = "Cidadao"
                Else
           End
           
        End If
    Dim Values As Variant
    
    Set lo = ThisWorkbook.Worksheets(planilha).ListObjects(tabela)
    
    ListBox1.ColumnCount = lo.ListColumns.Count
    Values = lo.DataBodyRange.Text
'    ListBox1.List = Values
    
    Debug.Print lo.DataBodyRange.Address(, , , 1)
    ListBox1.RowSource = lo.DataBodyRange.Address(, , , 1)
    
    UpdateCW
    txtpesquisa.Enabled = True
   
End Sub

Private Sub btnpesquisa_Click()

End Sub

Private Sub btnSair_Click()
    Unload Me
End Sub

Sub UpdateCW()
    Dim CW As Variant
    
    'ListBox1.ColumnWidths = "200;200;200;200;200"
    CW = lo.HeaderRowRange.Offset(-1).Value2
    CW = Application.Transpose(CW)
    CW = Application.Transpose(CW)
    
    ListBox1.ColumnWidths = Join(CW, ";")
End Sub


Private Sub txtpesquisa_Change()
 TextoDigitado = txtpesquisa.Text
 Call PreencheLista
End Sub


Private Sub UserForm_Initialize()
Me.cbpesquisa.RowSource = "cbo!r4:r17"
txtpesquisa.Enabled = False
End Sub


'       [Excel Avançado - Macros e Vba]


Private Sub TextBox1_Change()
    TextoDigitado = TextBox1.Text
    Call PreencheLista
End Sub

Private Sub PreencheLista()
    Dim ws As Worksheet
    Dim tb As ListObjects
    Dim i As Integer
    Dim TextoCelula As String
    Set ws = ThisWorkbook.Worksheets(planilha).ListObjects(tabela)
    i = 1
    ListBox1.Clear
    With ws
        While .Cells(i, 1).Value <> Empty
            TextoCelula = .Cells(i, 1).Value
            If UCase(Left(TextoCelula, Len(TextoDigitado))) = UCase(TextoDigitado) Then
                ListBox1.AddItem .Cells(i, 1)
            End If
            i = i + 1
        Wend
    End With
End Sub

Private Sub UserForm_Terminate()
txtpesquisa.Enabled = False
End Sub""
alguém saberia me ajudar com esse erro

Link to post
Share on other sites

0 answers to this question

Recommended Posts

There have been no answers to this question yet

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.

Guest
Answer this question...

×   Pasted as rich text.   Paste as plain text instead

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

Cloud Computing


  • Forum Statistics

    • Total Topics
      148679
    • Total Posts
      644499
×
×
  • Create New...