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
Pergunta
isinmg
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
Link para o comentário
Compartilhar em outros sites
0 respostass a esta questão
Posts Recomendados
Participe da discussão
Você pode postar agora e se registrar depois. Se você já tem uma conta, acesse agora para postar com sua conta.