[Resolvido]Filtrar caixas combinadas

Preciso filtrar os registros através de mais de uma caixa de texto, sendo caixa caixa para uma coluna.
Anexei o bd para facilitar o entendimento.

Amigo, existem varios exemplos aqui no forum... De uma pesquisada...



Recomendo esse metodo se for mais de uma Caixa Texto:
https://www.maximoaccess.com/t27719-resolvidofiltros-usando-listbox-requery-ou-botao-de-opcao-e-ou
Mensagem n26

Sem sua indicação de solução não teria solucionado, ja havia procurado, sem êxito. Obrigado Fabio!

Código adaptei a seguir:

Código:



Public Sub fncFiltrar(NomeCampoFoco As String)
Dim x As String, filtro As String, strSplit As String
Dim f(6) As String, cp(6) As Variant
Dim k As Variant, p As Byte
Dim booPos As Boolean

'------------------------------------------------------------------
' Variável x recebe o valor digitado na caixa de texto de filtragem
'-------------------------------------------------------------------

x = Me(NomeCampoFoco).Text: p = 0


'--------------------------------------------------------------------------------------
'Passa para a matrix Cp() todos os valores digitados nas caixas de texto de filtragens
'--------------------------------------------------------------------------------------
For p = 0 To 5
    cp(p) = IIf(InStr(NomeCampoFoco, "tx" & p + 1) > 0, x, Me("tx" & p + 1))
Next

'----------------------------------------------------------------------------------------------------------------------------
' Passa para a matrix f() os campos a serem filtrados, com os respectivos valores digitados nas caixas de texto de filtragens
'-----------------------------------------------------------------------------------------------------------------------------
f(0) = "Produto Like '*" & cp(0) & "*'"
f(1) = IIf(cp(1) = Chr(32), "Marca is null", "Marca Like '*" & cp(1) & "*'")
f(2) = IIf(cp(2) = Chr(32), "Modelo is null", "Modelo Like '*" & cp(2) & "*'")
f(3) = IIf(cp(3) = Chr(32), "Nome is null", "Nome Like '*" & cp(3) & "*'")
f(4) = IIf(cp(4) = Chr(32), "Material is null", "Material Like '*" & cp(4) & "*'")
f(5) = "TbProdEstoque.CodFornecedor Like '*" & cp(5) & "*'"

'------------------------------------------------------------------------------------------
'Passa para Variável strSplit o comprimento de texto da cada caixa de texto de filtragens
'Comprimento zero(0) significa que a caixa de texto de filtragem se encontra vazia
'Exemplo: strSplit = 2|0|1|0
'Significa que os campos 2 e 4 não receberam valores para serem filtrados
'------------------------------------------------------------------------------------------
strSplit = Len(cp(0) & "") & "|" & Len(cp(1) & "") & "|" & Len(cp(2) & "") & "|" & Len(cp(3) & "") & "|" & Len(cp(4) & "") & "|" & Len(cp(5) & "")
k = Split(strSplit, "|")

'----------------------------------------------------------------------------------------------
'Filtro assume todos os valores de registros caso todos os campos de filtragens estejam limpos
'----------------------------------------------------------------------------------------------
filtro = "CodProdutoDescricao > 0": p = 0

'------------------------------------------------------------------------------------------
'Monta a variável filtro com todos os campos de filtragens que possuirem valores digitados
'------------------------------------------------------------------------------------------
For p = 0 To UBound(k)
    If Val(k(p)) > 0 Then
        If booPos = False Then
            filtro = f(p): booPos = True
        Else
            filtro = filtro & " AND " & f(p)
        End If
    End If
Next p

'--------------------------------------------
'Carrga a listbox com os registros filtrados
'--------------------------------------------
Call fncCarregalista(filtro)
End Sub

Private Sub fncCarregalista(Optional filtro As String, Optional ordem As String)
Dim strSql As String
strSql = "SELECT Consul_Prod_DescEstoq.*"
strSql = strSql & " FROM Consul_Prod_DescEstoq  WHERE " & filtro
strSql = strSql & " ORDER BY Consul_Prod_DescEstoq.Produto, Consul_Prod_DescEstoq.Marca, Consul_Prod_DescEstoq.Modelo, Consul_Prod_DescEstoq.Material;"
Me.Form.RecordSource = strSql
filtroLista = filtro
End Sub

Private Sub Tx1_Change()
Call fncFiltrar(Me!Tx1.Name)
Me.Tx1.SetFocus
SendKeys "{F2}"
End Sub

Private Sub Tx2_Change()
Call fncFiltrar(Me!Tx2.Name)
Me.Tx2.SetFocus
SendKeys "{F2}"
End Sub

Private Sub Tx3_Change()
Call fncFiltrar(Me!Tx3.Name)
Me.Tx3.SetFocus
SendKeys "{F2}"
End Sub

Private Sub Tx4_Change()
Call fncFiltrar(Me!Tx4.Name)
Me.Tx4.SetFocus
SendKeys "{F2}"
End Sub

Private Sub Tx5_Change()
Call fncFiltrar(Me!Tx5.Name)
Me.Tx5.SetFocus
SendKeys "{F2}"
End Sub

Private Sub Tx6_Change()
Call fncFiltrar(Me!Tx6.Name)
Me.Tx6.SetFocus
SendKeys "{F2}"
End Sub


Bacana amigo, ate a proxima se Deus quiser...

Após vários testes, ao adicionar dados as caixas de texto e apagar, algumas vezes o sistema da erro na linha:

Código:

x = Me(NomeCampoFoco).Text: p = 0

Erro em tempo de execução '2185':
Você não pode fazer referência a uma propriedade ou a um método de um controle, a menos que o controle tenha o foco.

Se o formulário for fechado e reaberto o erro para de ocorrer, só volta ocorrer quando algumas das caixas que tinha texto volta ficar vazia.

porém  ja verifiquei que a caixa que esta sendo alterada confere, através do comando:

Código:

Msgbox Me(NomeCampoFoco).Name

ja tentei mover o foco antes da linha, através do comando:

Código:

Me(NomeCampoFoco).SetFocus

Não sei se é o certo, mas parou de dar erro após definir a origem de dados sem filtro

Código:

Me.Form.RecordSource = "SELECT Consul_Prod_DescEstoq.* " & _
        "FROM Consul_Prod_DescEstoq WHERE Consul_Prod_DescEstoq.Produto Like """ & Chr(42) & Txtprod & Chr(42) & """" & _
        "OR Consul_Prod_DescEstoq.Marca    Like """ & Chr(42) & Txtprod & Chr(42) & """" & _
        "OR Consul_Prod_DescEstoq.Modelo        Like """ & Chr(42) & Txtprod & Chr(42) & """" & _
        "OR Consul_Prod_DescEstoq.Material      Like """ & Chr(42) & Txtprod & Chr(42) & """" & _
        "OR Consul_Prod_DescEstoq.Nome    Like """ & Chr(42) & Txtprod & Chr(42) & """" & _
        "ORDER BY Consul_Prod_DescEstoq.Produto,marca,modelo,material ;"


Acredito que o problema, é que se apaga alguma informação de alguma, esta informação filtrada anteriormente ainda continua na consulta vba, mesmo não tem nenhuma informação na caixa de texto. Percebi isso ao exibir mensagem do recordsource que o campo fornecedor estava com a informação 91 e na caixa não tinha nenhuma informação e dava erro.