Ir para conteúdo
Fórum Script Brasil

isinmg

Membros
  • Total de itens

    1
  • Registro em

  • Última visita

Sobre isinmg

isinmg's Achievements

0

Reputação

  1. bom dia estou tentando criar um formulario de pesquisa com list box mais um filtro no text box, mas estou tendo dificuldades. """ 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
×
×
  • Criar Novo...