Ola galera eu adicionei 1 campo chamado nome
Ele está pesquisando mas não obedece a ordem de filtros.
Ex. eu coloco o dia,mes,ano,descrição ele filtra tudo correto.
mas ao colocar nome,documento,valor,forma. ele não obedece os filtros anteriores apenas fazendo filtro dos campos que estou digitando na atualidade.
e gostaria de adicionar o campo conta tambem.
Alguem poderia ajudar a ajustar esse codigo tenho penado um bocado.
Obs. os campos estão identificados como
dia tx5, mes tx6, ano tx7, descrição tx1 (funcionando corretamente)
nome tx8, n documento tx2, valor tx3, forma tx4 (funciona parcialmente faz o filtro mas não obedece os outros filtros)
adcionar mais uma conta -
Obrigado
Option Compare Database
Option Explicit
Private Const Az = 16777164
Private Const AM = 10092543
Private Function fCarregaLista(campo As Variant, filtro As String, campo2 As Variant, Filtro2 As Byte)
Dim mysql As String
On Error Resume Next
Select Case Me!Moldura
Case 1 'Despesas
mysql = "SELECT A.des_dia, C.Mes, B.Ano, A.des_Descrição, A.des_Nome, A.des_Documento, format(A.des_Valor,'#,##0.00'), "
mysql = mysql & "A.des_Forma , A.des_Conta, A.IdDespesas, A.des_status FROM tblAnos AS B "
mysql = mysql & "INNER JOIN (tblMeses AS C INNER JOIN tblDespesas AS A "
mysql = mysql & "ON C.Idmes = A.Idmes) ON B.IdAno = C.idAno "
mysql = mysql & "WHERE " & campo2 & "=" & Filtro2 & " AND " & campo & " Like '" & filtro & "*' "
mysql = mysql & "ORDER BY A.idDespesas DESC;"
Me!Rot.Caption = "CONSULTAR DESPESAS DE " & Me!Rot5.Caption
Me!Rot.ForeColor = 255
Case 2 'Receitas
mysql = "SELECT A.rec_dia, C.Mes, B.Ano, A.rec_Descrição, A.rec_Nome, A.rec_Documento, format(A.rec_Valor,'#,##0.00'), "
mysql = mysql & "A.rec_Forma, A.rec_Conta, A.IdReceita, A.rec_status FROM (tblAnos AS B INNER JOIN tblMeses AS C ON B.IdAno = C.idAno) "
mysql = mysql & "INNER JOIN tblReceitas AS A ON C.Idmes = A.Idmes "
mysql = mysql & "WHERE " & campo2 & "=" & Filtro2 & " AND " & campo & " Like '" & filtro & "*' "
mysql = mysql & "ORDER BY A.idReceita DESC;"
Me!Rot.Caption = "CONSULTAR RECEITAS DE " & Me!Rot5.Caption
Me!Rot.ForeColor = 16711680
End Select
Me!lista.RowSource = mysql
End Function
Private Sub btImprimirListagem_Click()
On Error Resume Next
Dim xfiltro As String, N As Single, sc As String
If Me!lista.ListCount = 0 Then
Me!tx1.SetFocus
Exit Sub
End If
sc = ""
Select Case Me!Moldura
Case 1
xfiltro = "idDespesas in("
Case 2
xfiltro = "idReceita in("
End Select
For N = 1 To Me!lista.ListCount
If N = 1 Then
sc = Me!lista.Column(9, N - 1)
Else
sc = sc & "," & Me!lista.Column(9, N - 1)
End If
Next
xfiltro = xfiltro & sc & ")"
Select Case Me!Moldura
Case 1
Call fImprimir("rltConsultaDespesas", True, 9, 1, 1.5, 1.5, 1, 1, 100, 0, 0)
Case 2
Call fImprimir("rltConsultaReceitas", True, 9, 1, 1.5, 1.5, 1, 1, 100, 0, 0)
End Select
End Sub
Private Sub btRemoverFiltro_Click()
On Error Resume Next
PlaySound fLocalBd & "\div\sons\click.wav", 1, 1
Call fLimparConsulta
End Sub
Private Sub Form_Open(Cancel As Integer)
On Error Resume Next
Select Case Me!Moldura
Case 1
Call fCarregaLista("A.des_Descrição", "*", "A.des_status", Me!Quadro)
Case 2
Call fCarregaLista("A.rec_Descrição", "*", "A.rec_Status", Me!Quadro)
End Select
Me!tx1.SetFocus
End Sub
Private Sub Moldura_AfterUpdate()
On Error Resume Next
PlaySound fLocalBd & "\div\sons\click.wav", 1, 1
Select Case Me!Moldura
Case 1
'Call fCarregaLista("A.des_Descrição", "*")
Me!Rot1.Caption = "Total Despesas"
Me!Rot2.Caption = "de Pessoal"
Me!Rot3.Caption = "Administrativa"
Me!Rot4.Caption = "Manutenção"
Me!Rot5.Caption = "D1"
Me!Rot6.Caption = "Material"
Me!Rot7.Caption = "Tarifas Publicas"
Case 2
'Call fCarregaLista("A.rec_Descrição", "*")
Me!Rot1.Caption = "Total Receita"
Me!Rot2.Caption = "Boletos"
Me!Rot3.Caption = "R3"
Me!Rot4.Caption = "R4"
Me!Rot5.Caption = "R1"
Me!Rot6.Caption = "R5"
Me!Rot7.Caption = "R6"
End Select
Me!Quadro = 0
Call fLimparConsulta
'Me!tx1.SetFocus
End Sub
Private Sub Quadro_AfterUpdate()
On Error Resume Next
Select Case Quadro
Case 0
Me!Rot5.Caption = IIf(Me!Moldura = 1, "D1", "R1")
Case 1
Me!Rot5.Caption = IIf(Me!Moldura = 1, "D2", "R2")
Case 2
Me!Rot5.Caption = IIf(Me!Moldura = 1, "D3", "R3")
Case 3
Me!Rot5.Caption = IIf(Me!Moldura = 1, "D4", "R4")
Case 4
Me!Rot5.Caption = IIf(Me!Moldura = 1, "D5", "R5")
Case 5
Me!Rot5.Caption = IIf(Me!Moldura = 1, "D6", "R6")
End Select
Call fLimparConsulta
End Sub
Private Sub Tx8_Change()
On Error Resume Next
Dim j As Byte, filtro As String, p As Boolean
j = 0: p = True
If Not IsNull(Me!tx5) Then j = j + 1
If Not IsNull(Me!tx6) Then j = j + 2
If Not IsNull(Me!tx7) Then j = j + 4
Select Case j
Case 0
If Me!Moldura = 1 Then
Call fCarregaLista("A.Des_Nome", Me!tx8.Text, "A.des_status", Me!Quadro)
Else
Call fCarregaLista("A.Rec_Nome", Me!tx8.Text, "A.rec_status", Me!Quadro)
End If
If Len(Me!tx8.Text) = 0 Then p = False
Case 1
If Me!Moldura = 1 Then
filtro = "A.Des_Dia Like '" & Me!tx5 & "*' AND A.Des_Nome"
Call fCarregaLista(filtro, Me!tx8.Text, "A.des_status", Me!Quadro)
Else
filtro = "A.Rec_Dia Like '" & Me!tx5 & "*' AND A.Rec_Nome"
Call fCarregaLista(filtro, Me!tx8.Text, "A.rec_status", Me!Quadro)
End If
Case 2
If Me!Moldura = 1 Then
filtro = "C.Mes Like '" & Me!tx6 & "*' AND A.Des_Nome"
Call fCarregaLista(filtro, Me!tx8.Text, "A.des_status", Me!Quadro)
Else
filtro = "C.Mes Like '" & Me!tx6 & "*' AND A.Rec_Nome"
Call fCarregaLista(filtro, Me!tx8.Text, "A.rec_status", Me!Quadro)
End If
Case 4
If Me!Moldura = 1 Then
filtro = "B.Ano Like '" & Me!tx7 & "*' AND A.Des_Nome"
Call fCarregaLista(filtro, Me!tx8.Text, "A.des_status", Me!Quadro)
Else
filtro = "B.Ano Like '" & Me!tx7 & "*' AND A.Rec_Nome"
Call fCarregaLista(filtro, Me!tx8.Text, "A.rec_status", Me!Quadro)
End If
Case 3
If Me!Moldura = 1 Then
filtro = "A.Des_Dia Like '" & Me!tx5 & "*' AND C.Mes Like '" & Me!tx6 & "*' AND A.Des_Nome"
Call fCarregaLista(filtro, Me!tx8.Text, "A.des_status", Me!Quadro)
Else
filtro = "A.Rec_Dia Like '" & Me!tx5 & "*' AND C.Mes Like '" & Me!tx6 & "*' AND A.Rec_Nome"
Call fCarregaLista(filtro, Me!tx8.Text, "A.rec_status", Me!Quadro)
End If
Case 5
If Me!Moldura = 1 Then
filtro = "A.Des_Dia Like '" & Me!tx5 & "*' AND B.Ano Like '" & Me!tx7 & "*' AND A.Des_Nome"
Call fCarregaLista(filtro, Me!tx8.Text, "A.des_status", Me!Quadro)
Else
filtro = "A.Rec_Dia Like '" & Me!tx5 & "*' AND B.Ano Like '" & Me!tx7 & "*' AND A.Rec_Nome"
Call fCarregaLista(filtro, Me!tx8.Text, "A.rec_status", Me!Quadro)
End If
Case 6
If Me!Moldura = 1 Then
filtro = "C.Mes Like '" & Me!tx6 & "*' AND B.Ano Like '" & Me!tx7 & "*' AND A.Des_Nome"
Call fCarregaLista(filtro, Me!tx8.Text, "A.des_status", Me!Quadro)
Else
filtro = "C.Mes Like '" & Me!tx6 & "*' AND B.Ano Like '" & Me!tx7 & "*' AND A.Rec_Nome"
Call fCarregaLista(filtro, Me!tx8.Text, "A.rec_status", Me!Quadro)
End If
Case 7
If Me!Moldura = 1 Then
filtro = "A.Des_dia Like '" & Me!tx5 & "*' AND B.Ano Like '" & Me!tx7 & "*' AND C.Mes Like '" & Me!tx6 & "*' AND A.Des_Nome"
Call fCarregaLista(filtro, Me!tx8.Text, "A.des_status", Me!Quadro)
Else
filtro = "A.Rec_Dia Like '" & Me!tx5 & "*' AND B.Ano Like '" & Me!tx7 & "*' AND C.Mes Like '" & Me!tx6 & "*' AND A.Rec_Nome"
Call fCarregaLista(filtro, Me!tx8.Text, "A.rec_status", Me!Quadro)
End If
End Select
Call fSomaLista(p)
End Sub
Private Sub Tx8_GotFocus()
On Error Resume Next
Me!lista.Value = -1
Call fcor(Me!tx1, "am")
End Sub
Private Sub Tx8_LostFocus()
On Error Resume Next
Call fcor(Me!tx1, "br")
End Sub
Private Sub tx1_Change()
On Error Resume Next
Dim j As Byte, filtro As String, p As Boolean
j = 0: p = True
If Not IsNull(Me!tx5) Then j = j + 1
If Not IsNull(Me!tx6) Then j = j + 2
If Not IsNull(Me!tx7) Then j = j + 4
Select Case j
Case 0
If Me!Moldura = 1 Then
Call fCarregaLista("A.Des_Descrição", Me!tx1.Text, "A.des_status", Me!Quadro)
Else
Call fCarregaLista("A.Rec_Descrição", Me!tx1.Text, "A.rec_status", Me!Quadro)
End If
If Len(Me!tx1.Text) = 0 Then p = False
Case 1
If Me!Moldura = 1 Then
filtro = "A.Des_Dia Like '" & Me!tx5 & "*' AND A.Des_Descrição"
Call fCarregaLista(filtro, Me!tx1.Text, "A.des_status", Me!Quadro)
Else
filtro = "A.Rec_Dia Like '" & Me!tx5 & "*' AND A.Rec_Descrição"
Call fCarregaLista(filtro, Me!tx1.Text, "A.rec_status", Me!Quadro)
End If
Case 2
If Me!Moldura = 1 Then
filtro = "C.Mes Like '" & Me!tx6 & "*' AND A.Des_Descrição"
Call fCarregaLista(filtro, Me!tx1.Text, "A.des_status", Me!Quadro)
Else
filtro = "C.Mes Like '" & Me!tx6 & "*' AND A.Rec_Descrição"
Call fCarregaLista(filtro, Me!tx1.Text, "A.rec_status", Me!Quadro)
End If
Case 4
If Me!Moldura = 1 Then
filtro = "B.Ano Like '" & Me!tx7 & "*' AND A.Des_Descrição"
Call fCarregaLista(filtro, Me!tx1.Text, "A.des_status", Me!Quadro)
Else
filtro = "B.Ano Like '" & Me!tx7 & "*' AND A.Rec_Descrição"
Call fCarregaLista(filtro, Me!tx1.Text, "A.rec_status", Me!Quadro)
End If
Case 3
If Me!Moldura = 1 Then
filtro = "A.Des_Dia Like '" & Me!tx5 & "*' AND C.Mes Like '" & Me!tx6 & "*' AND A.Des_Descrição"
Call fCarregaLista(filtro, Me!tx1.Text, "A.des_status", Me!Quadro)
Else
filtro = "A.Rec_Dia Like '" & Me!tx5 & "*' AND C.Mes Like '" & Me!tx6 & "*' AND A.Rec_Descrição"
Call fCarregaLista(filtro, Me!tx1.Text, "A.rec_status", Me!Quadro)
End If
Case 5
If Me!Moldura = 1 Then
filtro = "A.Des_Dia Like '" & Me!tx5 & "*' AND B.Ano Like '" & Me!tx7 & "*' AND A.Des_Descrição"
Call fCarregaLista(filtro, Me!tx1.Text, "A.des_status", Me!Quadro)
Else
filtro = "A.Rec_Dia Like '" & Me!tx5 & "*' AND B.Ano Like '" & Me!tx7 & "*' AND A.Rec_Descrição"
Call fCarregaLista(filtro, Me!tx1.Text, "A.rec_status", Me!Quadro)
End If
Case 6
If Me!Moldura = 1 Then
filtro = "C.Mes Like '" & Me!tx6 & "*' AND B.Ano Like '" & Me!tx7 & "*' AND A.Des_Descrição"
Call fCarregaLista(filtro, Me!tx1.Text, "A.des_status", Me!Quadro)
Else
filtro = "C.Mes Like '" & Me!tx6 & "*' AND B.Ano Like '" & Me!tx7 & "*' AND A.Rec_Descrição"
Call fCarregaLista(filtro, Me!tx1.Text, "A.rec_status", Me!Quadro)
End If
Case 7
If Me!Moldura = 1 Then
filtro = "A.Des_dia Like '" & Me!tx5 & "*' AND B.Ano Like '" & Me!tx7 & "*' AND C.Mes Like '" & Me!tx6 & "*' AND A.Des_Descrição"
Call fCarregaLista(filtro, Me!tx1.Text, "A.des_status", Me!Quadro)
Else
filtro = "A.Rec_Dia Like '" & Me!tx5 & "*' AND B.Ano Like '" & Me!tx7 & "*' AND C.Mes Like '" & Me!tx6 & "*' AND A.Rec_Descrição"
Call fCarregaLista(filtro, Me!tx1.Text, "A.rec_status", Me!Quadro)
End If
End Select
Call fSomaLista(p)
End Sub
Private Sub tx1_GotFocus()
On Error Resume Next
Me!lista.Value = -1
Call fcor(Me!tx1, "am")
End Sub
Private Sub tx1_LostFocus()
On Error Resume Next
Call fcor(Me!tx1, "br")
End Sub
Private Sub tx2_Change()
On Error Resume Next
Dim filtro As String, p As Boolean
p = True
Select Case Me!Moldura
Case 1
If Len(Me!tx2.Text) = 0 Then
filtro = "C.Mes"
p = False
Else
filtro = "A.des_Documento"
End If
Call fCarregaLista(filtro, Me!tx2.Text, "A.des_status", Me!Quadro)
Case 2
If Len(Me!tx2.Text) = 0 Then
filtro = "C.Mes"
p = False
Else
filtro = "A.rec_Documento"
End If
Call fCarregaLista(filtro, Me!tx2.Text, "A.rec_status", Me!Quadro)
End Select
Call fSomaLista(p)
End Sub
Private Sub tx2_GotFocus()
On Error Resume Next
Me!lista.Value = -1
Call fcor(Me!tx2, "am")
End Sub
Private Sub tx2_LostFocus()
On Error Resume Next
Call fcor(Me!tx2, "br")
Me!tx2 = Null
End Sub
Private Sub tx3_Change()
On Error Resume Next
Dim filtro As String, p As Boolean
p = True
Select Case Me!Moldura
Case 1
If Len(Me!tx3.Text) = 0 Then
filtro = "C.Mes"
p = False
Else
filtro = "A.des_Valor"
End If
Call fCarregaLista(filtro, Me!tx3.Text, "A.des_status", Me!Quadro)
Case 2
If Len(Me!tx3.Text) = 0 Then
filtro = "C.Mes"
p = False
Else
filtro = "A.rec_Valor"
End If
Call fCarregaLista(filtro, Me!tx3.Text, "A.rec_status", Me!Quadro)
End Select
Call fSomaLista(p)
End Sub
Private Sub tx3_GotFocus()
On Error Resume Next
Me!lista.Value = -1
Call fcor(Me!tx3, "am")
End Sub
Private Sub tx3_LostFocus()
On Error Resume Next
Call fcor(Me!tx3, "br")
Me!tx3 = Null
End Sub
Private Sub tx4_Change()
On Error Resume Next
Dim filtro As String, p As Boolean
p = True
Select Case Me!Moldura
Case 1
If Len(Me!tx4.Text) = 0 Then
filtro = "C.Mes"
p = False
Else
filtro = "A.des_Forma"
End If
Call fCarregaLista(filtro, Me!tx4.Text, "A.des_status", Me!Quadro)
Case 2
If Len(Me!tx4.Text) = 0 Then
filtro = "C.Mes"
p = False
Else
filtro = "A.Rec_Forma"
End If
Call fCarregaLista(filtro, Me!tx4.Text, "A.rec_status", Me!Quadro)
End Select
Call fSomaLista(p)
End Sub
Private Sub tx4_GotFocus()
On Error Resume Next
Me!lista.Value = -1
Call fcor(Me!tx4, "am")
End Sub
Private Sub tx4_LostFocus()
On Error Resume Next
Call fcor(Me!tx4, "br")
Me!tx4 = Null
End Sub
Private Sub tx5_Change()
On Error Resume Next
Dim j As Byte, filtro As String, p As Boolean
j = 0: p = True
If Not IsNull(Me!tx1) Then j = j + 1
If Not IsNull(Me!tx6) Then j = j + 2
If Not IsNull(Me!tx7) Then j = j + 4
Select Case j
Case 0
If Me!Moldura = 1 Then
Call fCarregaLista("A.des_Dia", Me!tx5.Text, "A.des_status", Me!Quadro)
Else
Call fCarregaLista("A.rec_Dia", Me!tx5.Text, "A.rec_status", Me!Quadro)
End If
If Len(Me!tx5.Text) = 0 Then p = False
Case 1
If Me!Moldura = 1 Then
filtro = "A.Des_Descrição Like '" & Me!tx1 & "*' AND A.Des_Dia"
Call fCarregaLista(filtro, Me!tx5.Text, "A.des_status", Me!Quadro)
Else
filtro = "A.Rec_Descrição Like '" & Me!tx1 & "*' AND A.Rec_Dia"
Call fCarregaLista(filtro, Me!tx5.Text, "A.rec_status", Me!Quadro)
End If
Case 2
If Me!Moldura = 1 Then
filtro = "C.Mes Like '" & Me!tx6 & "*' AND A.Des_Dia"
Call fCarregaLista(filtro, Me!tx5.Text, "A.des_status", Me!Quadro)
Else
filtro = "C.Mes Like '" & Me!tx6 & "*' AND A.Rec_Dia"
Call fCarregaLista(filtro, Me!tx5.Text, "A.rec_status", Me!Quadro)
End If
Case 4
If Me!Moldura = 1 Then
filtro = "B.Ano Like '" & Me!tx7 & "*' AND A.Des_Dia"
Call fCarregaLista(filtro, Me!tx5.Text, "A.des_status", Me!Quadro)
Else
filtro = "B.Ano Like '" & Me!tx7 & "*' AND A.Rec_Dia"
Call fCarregaLista(filtro, Me!tx5.Text, "A.rec_status", Me!Quadro)
End If
Case 3
If Me!Moldura = 1 Then
filtro = "A.Des_Descrição Like '" & Me!tx1 & "*' AND C.Mes Like '" & Me!tx6 & "*' AND A.Des_Dia"
Call fCarregaLista(filtro, Me!tx5.Text, "A.des_status", Me!Quadro)
Else
filtro = "A.Rec_Descrição Like '" & Me!tx1 & "*' AND C.Mes Like '" & Me!tx6 & "*' AND A.Rec_Dia"
Call fCarregaLista(filtro, Me!tx5.Text, "A.rec_status", Me!Quadro)
End If
Case 5
If Me!Moldura = 1 Then
filtro = "A.Des_Descrição Like '" & Me!tx1 & "*' AND B.Ano Like '" & Me!tx7 & "*' AND A.Des_Dia"
Call fCarregaLista(filtro, Me!tx5.Text, "A.des_status", Me!Quadro)
Else
filtro = "A.Rec_Descrição Like '" & Me!tx1 & "*' AND B.Ano Like '" & Me!tx7 & "*' AND A.Rec_Dia"
Call fCarregaLista(filtro, Me!tx5.Text, "A.rec_status", Me!Quadro)
End If
Case 6
If Me!Moldura = 1 Then
filtro = "C.Mes Like '" & Me!tx6 & "*' AND B.Ano Like '" & Me!tx7 & "*' AND A.Des_Dia"
Call fCarregaLista(filtro, Me!tx5.Text, "A.des_status", Me!Quadro)
Else
filtro = "C.Mes Like '" & Me!tx6 & "*' AND B.Ano Like '" & Me!tx7 & "*' AND A.Rec_Dia"
Call fCarregaLista(filtro, Me!tx5.Text, "A.rec_status", Me!Quadro)
End If
Case 7
If Me!Moldura = 1 Then
filtro = "A.Des_Descrição Like '" & Me!tx1 & "*' AND B.Ano Like '" & Me!tx7 & "*' AND C.Mes Like '" & Me!tx6 & "*' AND A.Des_Dia"
Call fCarregaLista(filtro, Me!tx5.Text, "A.des_status", Me!Quadro)
Else
filtro = "A.Rec_Descrição Like '" & Me!tx1 & "*' AND B.Ano Like '" & Me!tx7 & "*' AND C.Mes Like '" & Me!tx6 & "*' AND A.Rec_Dia"
Call fCarregaLista(filtro, Me!tx5.Text, "A.rec_status", Me!Quadro)
End If
End Select
Call fSomaLista(p)
End Sub
Private Sub tx5_GotFocus()
On Error Resume Next
Me!lista.Value = -1
Call fcor(Me!tx5, "am")
End Sub
Private Sub Tx5_LostFocus()
On Error Resume Next
Call fcor(Me!tx5, "br")
End Sub
Private Sub tx6_Change()
On Error Resume Next
Dim j As Byte, filtro As String, p As Boolean
j = 0: p = True
If Not IsNull(Me!tx1) Then j = j + 1
If Not IsNull(Me!tx5) Then j = j + 2
If Not IsNull(Me!tx7) Then j = j + 4
Select Case j
Case 0
If Me!Moldura = 1 Then
Call fCarregaLista("C.Mes", Me!tx6.Text, "A.des_status", Me!Quadro)
Else
Call fCarregaLista("C.Mes", Me!tx6.Text, "A.rec_status", Me!Quadro)
End If
If Len(Me!tx6.Text) = 0 Then p = False
Case 1
If Me!Moldura = 1 Then
filtro = "A.Des_Descrição Like '" & Me!tx1 & "*' AND C.Mes"
Call fCarregaLista(filtro, Me!tx6.Text, "A.des_status", Me!Quadro)
Else
filtro = "A.Rec_Descrição Like '" & Me!tx1 & "*' AND C.Mes"
Call fCarregaLista(filtro, Me!tx6.Text, "A.rec_status", Me!Quadro)
End If
Case 2
If Me!Moldura = 1 Then
filtro = "A.Des_dia Like '" & Me!tx5 & "*' AND C.Mes"
Call fCarregaLista(filtro, Me!tx6.Text, "A.des_status", Me!Quadro)
Else
filtro = "A.Rec_dia Like '" & Me!tx5 & "*' AND C.Mes"
Call fCarregaLista(filtro, Me!tx6.Text, "A.rec_status", Me!Quadro)
End If
Case 4
filtro = "B.Ano Like '" & Me!tx7 & "*' AND C.Mes"
If Me!Moldura = 1 Then
Call fCarregaLista(filtro, Me!tx6.Text, "A.des_status", Me!Quadro)
Else
Call fCarregaLista(filtro, Me!tx6.Text, "A.rec_status", Me!Quadro)
End If
Case 3
If Me!Moldura = 1 Then
filtro = "A.Des_Descrição Like '" & Me!tx1 & "*' AND A.Des_dia Like '" & Me!tx5 & "*' AND C.Mes"
Call fCarregaLista(filtro, Me!tx6.Text, "A.des_status", Me!Quadro)
Else
filtro = "A.Rec_Descrição Like '" & Me!tx1 & "*' AND A.Rec_dia Like '" & Me!tx5 & "*' AND C.Mes"
Call fCarregaLista(filtro, Me!tx6.Text, "A.rec_status", Me!Quadro)
End If
Case 5
If Me!Moldura = 1 Then
filtro = "A.Des_Descrição Like '" & Me!tx1 & "*' AND B.Ano Like '" & Me!tx7 & "*' AND C.Mes"
Call fCarregaLista(filtro, Me!tx6.Text, "A.des_status", Me!Quadro)
Else
filtro = "A.Rec_Descrição Like '" & Me!tx1 & "*' AND B.Ano Like '" & Me!tx7 & "*' AND C.Mes"
Call fCarregaLista(filtro, Me!tx6.Text, "A.rec_status", Me!Quadro)
End If
Case 6
If Me!Moldura = 1 Then
filtro = "A.Des_dia Like '" & Me!tx5 & "*' AND B.Ano Like '" & Me!tx7 & "*' AND C.Mes"
Call fCarregaLista(filtro, Me!tx6.Text, "A.des_status", Me!Quadro)
Else
filtro = "A.Rec_dia Like '" & Me!tx5 & "*' AND B.Ano Like '" & Me!tx7 & "*' AND C.Mes"
Call fCarregaLista(filtro, Me!tx6.Text, "A.rec_status", Me!Quadro)
End If
Case 7
If Me!Moldura = 1 Then
filtro = "A.Des_Descrição Like '" & Me!tx1 & "*' AND B.Ano Like '" & Me!tx7 & "*' AND A.Des_dia Like '" & Me!tx5 & "*' AND C.Mes"
Call fCarregaLista(filtro, Me!tx6.Text, "A.des_status", Me!Quadro)
Else
filtro = "A.Rec_Descrição Like '" & Me!tx1 & "*' AND B.Ano Like '" & Me!tx7 & "*' AND A.Rec_dia Like '" & Me!tx5 & "*' AND C.Mes"
Call fCarregaLista(filtro, Me!tx6.Text, "A.rec_status", Me!Quadro)
End If
End Select
Call fSomaLista(p)
End Sub
Private Sub tx6_GotFocus()
On Error Resume Next
Me!lista.Value = -1
Call fcor(Me!tx6, "am")
End Sub
Private Sub Tx6_LostFocus()
On Error Resume Next
Call fcor(Me!tx6, "br")
End Sub
Private Sub tx7_Change()
On Error Resume Next
Dim j As Byte, filtro As String, p As Boolean
j = 0: p = True
If Not IsNull(Me!tx1) Then j = j + 1
If Not IsNull(Me!tx5) Then j = j + 2
If Not IsNull(Me!tx6) Then j = j + 4
Select Case j
Case 0
If Me!Moldura = 1 Then
Call fCarregaLista("B.Ano", Me!tx7.Text, "A.des_status", Me!Quadro)
Else
Call fCarregaLista("B.Ano", Me!tx7.Text, "A.rec_status", Me!Quadro)
End If
If Len(Me!tx7.Text) = 0 Then p = False
Case 1
If Me!Moldura = 1 Then
filtro = "A.Des_Descrição Like '" & Me!tx1 & "*' AND B.Ano"
Call fCarregaLista(filtro, Me!tx7.Text, "A.des_status", Me!Quadro)
Else
filtro = "A.Rec_Descrição Like '" & Me!tx1 & "*' AND B.Ano"
Call fCarregaLista(filtro, Me!tx7.Text, "A.rec_status", Me!Quadro)
End If
Case 2
If Me!Moldura = 1 Then
filtro = "A.Des_dia Like '" & Me!tx5 & "*' AND B.Ano"
Call fCarregaLista(filtro, Me!tx7.Text, "A.des_status", Me!Quadro)
Else
filtro = "A.Rec_dia Like '" & Me!tx5 & "*' AND B.Ano"
Call fCarregaLista(filtro, Me!tx7.Text, "A.rec_status", Me!Quadro)
End If
Case 4
filtro = "C.Mes Like '" & Me!tx6 & "*' AND B.Ano"
If Me!Moldura = 1 Then
Call fCarregaLista(filtro, Me!tx7.Text, "A.des_status", Me!Quadro)
Else
Call fCarregaLista(filtro, Me!tx7.Text, "A.rec_status", Me!Quadro)
End If
Case 3
If Me!Moldura = 1 Then
filtro = "A.Des_Descrição Like '" & Me!tx1 & "*' AND A.Des_dia Like '" & Me!tx5 & "*' AND B.Ano"
Call fCarregaLista(filtro, Me!tx7.Text, "A.des_status", Me!Quadro)
Else
filtro = "A.Rec_Descrição Like '" & Me!tx1 & "*' AND A.Rec_dia Like '" & Me!tx5 & "*' AND B.Ano"
Call fCarregaLista(filtro, Me!tx7.Text, "A.rec_status", Me!Quadro)
End If
Case 5
If Me!Moldura = 1 Then
filtro = "A.Des_Descrição Like '" & Me!tx1 & "*' AND C.Mes Like '" & Me!tx6 & "*' AND B.Ano"
Call fCarregaLista(filtro, Me!tx7.Text, "A.des_status", Me!Quadro)
Else
filtro = "A.Rec_Descrição Like '" & Me!tx1 & "*' AND C.Mes Like '" & Me!tx6 & "*' AND B.Ano"
Call fCarregaLista(filtro, Me!tx7.Text, "A.rec_status", Me!Quadro)
End If
Case 6
If Me!Moldura = 1 Then
filtro = "A.Des_dia Like '" & Me!tx5 & "*' AND C.Mes Like '" & Me!tx6 & "*' AND B.Ano"
Call fCarregaLista(filtro, Me!tx7.Text, "A.des_status", Me!Quadro)
Else
filtro = "A.Rec_dia Like '" & Me!tx5 & "*' AND C.Mes Like '" & Me!tx6 & "*' AND B.Ano"
Call fCarregaLista(filtro, Me!tx7.Text, "A.rec_status", Me!Quadro)
End If
Case 7
If Me!Moldura = 1 Then
filtro = "A.Des_Descrição Like '" & Me!tx1 & "*' AND C.Mes Like '" & Me!tx6 & "*' AND A.Des_dia Like '" & Me!tx5 & "*' AND B.Ano"
Call fCarregaLista(filtro, Me!tx7.Text, "A.des_status", Me!Quadro)
Else
filtro = "A.Rec_Descrição Like '" & Me!tx1 & "*' AND C.Mes Like '" & Me!tx6 & "*' AND A.Rec_dia Like '" & Me!tx5 & "*' AND B.Ano"
Call fCarregaLista(filtro, Me!tx7.Text, "A.rec_status", Me!Quadro)
End If
End Select
Call fSomaLista(p)
End Sub
Private Sub tx7_GotFocus()
On Error Resume Next
Me!lista.Value = -1
Call fcor(Me!tx7, "am")
End Sub
Private Sub Tx7_LostFocus()
On Error Resume Next
Call fcor(Me!tx7, "br")
End Sub
Private Function fLimparConsulta()
Me!tx1 = Null: Me!tx2 = Null: Me!tx3 = Null: Me!tx4 = Null
Me!tx5 = Null: Me!tx6 = Null: Me!tx7 = Null: Me!tx8 = Null: Me!ValorLista = Null
Select Case Me!Moldura
Case 1
Call fCarregaLista("A.des_Descrição", "*", "A.des_status", Me!Quadro)
Case 2
Call fCarregaLista("A.rec_Descrição", "*", "A.Rec_status", Me!Quadro)
End Select
Me!tx1.SetFocus
End Function
Private Function fSomaLista(xSoma As Boolean)
On Error Resume Next
If xSoma = False Then
Me!ValorLista = Null
Exit Function
End If
Dim K As Long, xValor As Double
For K = 0 To Me!lista.ListCount - 1
xValor = xValor + Me!lista.Column(6, K)
Next
Me!ValorLista = xValor
End Function
Ele está pesquisando mas não obedece a ordem de filtros.
Ex. eu coloco o dia,mes,ano,descrição ele filtra tudo correto.
mas ao colocar nome,documento,valor,forma. ele não obedece os filtros anteriores apenas fazendo filtro dos campos que estou digitando na atualidade.
e gostaria de adicionar o campo conta tambem.
Alguem poderia ajudar a ajustar esse codigo tenho penado um bocado.
Obs. os campos estão identificados como
dia tx5, mes tx6, ano tx7, descrição tx1 (funcionando corretamente)
nome tx8, n documento tx2, valor tx3, forma tx4 (funciona parcialmente faz o filtro mas não obedece os outros filtros)
adcionar mais uma conta -
Obrigado
Option Compare Database
Option Explicit
Private Const Az = 16777164
Private Const AM = 10092543
Private Function fCarregaLista(campo As Variant, filtro As String, campo2 As Variant, Filtro2 As Byte)
Dim mysql As String
On Error Resume Next
Select Case Me!Moldura
Case 1 'Despesas
mysql = "SELECT A.des_dia, C.Mes, B.Ano, A.des_Descrição, A.des_Nome, A.des_Documento, format(A.des_Valor,'#,##0.00'), "
mysql = mysql & "A.des_Forma , A.des_Conta, A.IdDespesas, A.des_status FROM tblAnos AS B "
mysql = mysql & "INNER JOIN (tblMeses AS C INNER JOIN tblDespesas AS A "
mysql = mysql & "ON C.Idmes = A.Idmes) ON B.IdAno = C.idAno "
mysql = mysql & "WHERE " & campo2 & "=" & Filtro2 & " AND " & campo & " Like '" & filtro & "*' "
mysql = mysql & "ORDER BY A.idDespesas DESC;"
Me!Rot.Caption = "CONSULTAR DESPESAS DE " & Me!Rot5.Caption
Me!Rot.ForeColor = 255
Case 2 'Receitas
mysql = "SELECT A.rec_dia, C.Mes, B.Ano, A.rec_Descrição, A.rec_Nome, A.rec_Documento, format(A.rec_Valor,'#,##0.00'), "
mysql = mysql & "A.rec_Forma, A.rec_Conta, A.IdReceita, A.rec_status FROM (tblAnos AS B INNER JOIN tblMeses AS C ON B.IdAno = C.idAno) "
mysql = mysql & "INNER JOIN tblReceitas AS A ON C.Idmes = A.Idmes "
mysql = mysql & "WHERE " & campo2 & "=" & Filtro2 & " AND " & campo & " Like '" & filtro & "*' "
mysql = mysql & "ORDER BY A.idReceita DESC;"
Me!Rot.Caption = "CONSULTAR RECEITAS DE " & Me!Rot5.Caption
Me!Rot.ForeColor = 16711680
End Select
Me!lista.RowSource = mysql
End Function
Private Sub btImprimirListagem_Click()
On Error Resume Next
Dim xfiltro As String, N As Single, sc As String
If Me!lista.ListCount = 0 Then
Me!tx1.SetFocus
Exit Sub
End If
sc = ""
Select Case Me!Moldura
Case 1
xfiltro = "idDespesas in("
Case 2
xfiltro = "idReceita in("
End Select
For N = 1 To Me!lista.ListCount
If N = 1 Then
sc = Me!lista.Column(9, N - 1)
Else
sc = sc & "," & Me!lista.Column(9, N - 1)
End If
Next
xfiltro = xfiltro & sc & ")"
Select Case Me!Moldura
Case 1
Call fImprimir("rltConsultaDespesas", True, 9, 1, 1.5, 1.5, 1, 1, 100, 0, 0)
Case 2
Call fImprimir("rltConsultaReceitas", True, 9, 1, 1.5, 1.5, 1, 1, 100, 0, 0)
End Select
End Sub
Private Sub btRemoverFiltro_Click()
On Error Resume Next
PlaySound fLocalBd & "\div\sons\click.wav", 1, 1
Call fLimparConsulta
End Sub
Private Sub Form_Open(Cancel As Integer)
On Error Resume Next
Select Case Me!Moldura
Case 1
Call fCarregaLista("A.des_Descrição", "*", "A.des_status", Me!Quadro)
Case 2
Call fCarregaLista("A.rec_Descrição", "*", "A.rec_Status", Me!Quadro)
End Select
Me!tx1.SetFocus
End Sub
Private Sub Moldura_AfterUpdate()
On Error Resume Next
PlaySound fLocalBd & "\div\sons\click.wav", 1, 1
Select Case Me!Moldura
Case 1
'Call fCarregaLista("A.des_Descrição", "*")
Me!Rot1.Caption = "Total Despesas"
Me!Rot2.Caption = "de Pessoal"
Me!Rot3.Caption = "Administrativa"
Me!Rot4.Caption = "Manutenção"
Me!Rot5.Caption = "D1"
Me!Rot6.Caption = "Material"
Me!Rot7.Caption = "Tarifas Publicas"
Case 2
'Call fCarregaLista("A.rec_Descrição", "*")
Me!Rot1.Caption = "Total Receita"
Me!Rot2.Caption = "Boletos"
Me!Rot3.Caption = "R3"
Me!Rot4.Caption = "R4"
Me!Rot5.Caption = "R1"
Me!Rot6.Caption = "R5"
Me!Rot7.Caption = "R6"
End Select
Me!Quadro = 0
Call fLimparConsulta
'Me!tx1.SetFocus
End Sub
Private Sub Quadro_AfterUpdate()
On Error Resume Next
Select Case Quadro
Case 0
Me!Rot5.Caption = IIf(Me!Moldura = 1, "D1", "R1")
Case 1
Me!Rot5.Caption = IIf(Me!Moldura = 1, "D2", "R2")
Case 2
Me!Rot5.Caption = IIf(Me!Moldura = 1, "D3", "R3")
Case 3
Me!Rot5.Caption = IIf(Me!Moldura = 1, "D4", "R4")
Case 4
Me!Rot5.Caption = IIf(Me!Moldura = 1, "D5", "R5")
Case 5
Me!Rot5.Caption = IIf(Me!Moldura = 1, "D6", "R6")
End Select
Call fLimparConsulta
End Sub
Private Sub Tx8_Change()
On Error Resume Next
Dim j As Byte, filtro As String, p As Boolean
j = 0: p = True
If Not IsNull(Me!tx5) Then j = j + 1
If Not IsNull(Me!tx6) Then j = j + 2
If Not IsNull(Me!tx7) Then j = j + 4
Select Case j
Case 0
If Me!Moldura = 1 Then
Call fCarregaLista("A.Des_Nome", Me!tx8.Text, "A.des_status", Me!Quadro)
Else
Call fCarregaLista("A.Rec_Nome", Me!tx8.Text, "A.rec_status", Me!Quadro)
End If
If Len(Me!tx8.Text) = 0 Then p = False
Case 1
If Me!Moldura = 1 Then
filtro = "A.Des_Dia Like '" & Me!tx5 & "*' AND A.Des_Nome"
Call fCarregaLista(filtro, Me!tx8.Text, "A.des_status", Me!Quadro)
Else
filtro = "A.Rec_Dia Like '" & Me!tx5 & "*' AND A.Rec_Nome"
Call fCarregaLista(filtro, Me!tx8.Text, "A.rec_status", Me!Quadro)
End If
Case 2
If Me!Moldura = 1 Then
filtro = "C.Mes Like '" & Me!tx6 & "*' AND A.Des_Nome"
Call fCarregaLista(filtro, Me!tx8.Text, "A.des_status", Me!Quadro)
Else
filtro = "C.Mes Like '" & Me!tx6 & "*' AND A.Rec_Nome"
Call fCarregaLista(filtro, Me!tx8.Text, "A.rec_status", Me!Quadro)
End If
Case 4
If Me!Moldura = 1 Then
filtro = "B.Ano Like '" & Me!tx7 & "*' AND A.Des_Nome"
Call fCarregaLista(filtro, Me!tx8.Text, "A.des_status", Me!Quadro)
Else
filtro = "B.Ano Like '" & Me!tx7 & "*' AND A.Rec_Nome"
Call fCarregaLista(filtro, Me!tx8.Text, "A.rec_status", Me!Quadro)
End If
Case 3
If Me!Moldura = 1 Then
filtro = "A.Des_Dia Like '" & Me!tx5 & "*' AND C.Mes Like '" & Me!tx6 & "*' AND A.Des_Nome"
Call fCarregaLista(filtro, Me!tx8.Text, "A.des_status", Me!Quadro)
Else
filtro = "A.Rec_Dia Like '" & Me!tx5 & "*' AND C.Mes Like '" & Me!tx6 & "*' AND A.Rec_Nome"
Call fCarregaLista(filtro, Me!tx8.Text, "A.rec_status", Me!Quadro)
End If
Case 5
If Me!Moldura = 1 Then
filtro = "A.Des_Dia Like '" & Me!tx5 & "*' AND B.Ano Like '" & Me!tx7 & "*' AND A.Des_Nome"
Call fCarregaLista(filtro, Me!tx8.Text, "A.des_status", Me!Quadro)
Else
filtro = "A.Rec_Dia Like '" & Me!tx5 & "*' AND B.Ano Like '" & Me!tx7 & "*' AND A.Rec_Nome"
Call fCarregaLista(filtro, Me!tx8.Text, "A.rec_status", Me!Quadro)
End If
Case 6
If Me!Moldura = 1 Then
filtro = "C.Mes Like '" & Me!tx6 & "*' AND B.Ano Like '" & Me!tx7 & "*' AND A.Des_Nome"
Call fCarregaLista(filtro, Me!tx8.Text, "A.des_status", Me!Quadro)
Else
filtro = "C.Mes Like '" & Me!tx6 & "*' AND B.Ano Like '" & Me!tx7 & "*' AND A.Rec_Nome"
Call fCarregaLista(filtro, Me!tx8.Text, "A.rec_status", Me!Quadro)
End If
Case 7
If Me!Moldura = 1 Then
filtro = "A.Des_dia Like '" & Me!tx5 & "*' AND B.Ano Like '" & Me!tx7 & "*' AND C.Mes Like '" & Me!tx6 & "*' AND A.Des_Nome"
Call fCarregaLista(filtro, Me!tx8.Text, "A.des_status", Me!Quadro)
Else
filtro = "A.Rec_Dia Like '" & Me!tx5 & "*' AND B.Ano Like '" & Me!tx7 & "*' AND C.Mes Like '" & Me!tx6 & "*' AND A.Rec_Nome"
Call fCarregaLista(filtro, Me!tx8.Text, "A.rec_status", Me!Quadro)
End If
End Select
Call fSomaLista(p)
End Sub
Private Sub Tx8_GotFocus()
On Error Resume Next
Me!lista.Value = -1
Call fcor(Me!tx1, "am")
End Sub
Private Sub Tx8_LostFocus()
On Error Resume Next
Call fcor(Me!tx1, "br")
End Sub
Private Sub tx1_Change()
On Error Resume Next
Dim j As Byte, filtro As String, p As Boolean
j = 0: p = True
If Not IsNull(Me!tx5) Then j = j + 1
If Not IsNull(Me!tx6) Then j = j + 2
If Not IsNull(Me!tx7) Then j = j + 4
Select Case j
Case 0
If Me!Moldura = 1 Then
Call fCarregaLista("A.Des_Descrição", Me!tx1.Text, "A.des_status", Me!Quadro)
Else
Call fCarregaLista("A.Rec_Descrição", Me!tx1.Text, "A.rec_status", Me!Quadro)
End If
If Len(Me!tx1.Text) = 0 Then p = False
Case 1
If Me!Moldura = 1 Then
filtro = "A.Des_Dia Like '" & Me!tx5 & "*' AND A.Des_Descrição"
Call fCarregaLista(filtro, Me!tx1.Text, "A.des_status", Me!Quadro)
Else
filtro = "A.Rec_Dia Like '" & Me!tx5 & "*' AND A.Rec_Descrição"
Call fCarregaLista(filtro, Me!tx1.Text, "A.rec_status", Me!Quadro)
End If
Case 2
If Me!Moldura = 1 Then
filtro = "C.Mes Like '" & Me!tx6 & "*' AND A.Des_Descrição"
Call fCarregaLista(filtro, Me!tx1.Text, "A.des_status", Me!Quadro)
Else
filtro = "C.Mes Like '" & Me!tx6 & "*' AND A.Rec_Descrição"
Call fCarregaLista(filtro, Me!tx1.Text, "A.rec_status", Me!Quadro)
End If
Case 4
If Me!Moldura = 1 Then
filtro = "B.Ano Like '" & Me!tx7 & "*' AND A.Des_Descrição"
Call fCarregaLista(filtro, Me!tx1.Text, "A.des_status", Me!Quadro)
Else
filtro = "B.Ano Like '" & Me!tx7 & "*' AND A.Rec_Descrição"
Call fCarregaLista(filtro, Me!tx1.Text, "A.rec_status", Me!Quadro)
End If
Case 3
If Me!Moldura = 1 Then
filtro = "A.Des_Dia Like '" & Me!tx5 & "*' AND C.Mes Like '" & Me!tx6 & "*' AND A.Des_Descrição"
Call fCarregaLista(filtro, Me!tx1.Text, "A.des_status", Me!Quadro)
Else
filtro = "A.Rec_Dia Like '" & Me!tx5 & "*' AND C.Mes Like '" & Me!tx6 & "*' AND A.Rec_Descrição"
Call fCarregaLista(filtro, Me!tx1.Text, "A.rec_status", Me!Quadro)
End If
Case 5
If Me!Moldura = 1 Then
filtro = "A.Des_Dia Like '" & Me!tx5 & "*' AND B.Ano Like '" & Me!tx7 & "*' AND A.Des_Descrição"
Call fCarregaLista(filtro, Me!tx1.Text, "A.des_status", Me!Quadro)
Else
filtro = "A.Rec_Dia Like '" & Me!tx5 & "*' AND B.Ano Like '" & Me!tx7 & "*' AND A.Rec_Descrição"
Call fCarregaLista(filtro, Me!tx1.Text, "A.rec_status", Me!Quadro)
End If
Case 6
If Me!Moldura = 1 Then
filtro = "C.Mes Like '" & Me!tx6 & "*' AND B.Ano Like '" & Me!tx7 & "*' AND A.Des_Descrição"
Call fCarregaLista(filtro, Me!tx1.Text, "A.des_status", Me!Quadro)
Else
filtro = "C.Mes Like '" & Me!tx6 & "*' AND B.Ano Like '" & Me!tx7 & "*' AND A.Rec_Descrição"
Call fCarregaLista(filtro, Me!tx1.Text, "A.rec_status", Me!Quadro)
End If
Case 7
If Me!Moldura = 1 Then
filtro = "A.Des_dia Like '" & Me!tx5 & "*' AND B.Ano Like '" & Me!tx7 & "*' AND C.Mes Like '" & Me!tx6 & "*' AND A.Des_Descrição"
Call fCarregaLista(filtro, Me!tx1.Text, "A.des_status", Me!Quadro)
Else
filtro = "A.Rec_Dia Like '" & Me!tx5 & "*' AND B.Ano Like '" & Me!tx7 & "*' AND C.Mes Like '" & Me!tx6 & "*' AND A.Rec_Descrição"
Call fCarregaLista(filtro, Me!tx1.Text, "A.rec_status", Me!Quadro)
End If
End Select
Call fSomaLista(p)
End Sub
Private Sub tx1_GotFocus()
On Error Resume Next
Me!lista.Value = -1
Call fcor(Me!tx1, "am")
End Sub
Private Sub tx1_LostFocus()
On Error Resume Next
Call fcor(Me!tx1, "br")
End Sub
Private Sub tx2_Change()
On Error Resume Next
Dim filtro As String, p As Boolean
p = True
Select Case Me!Moldura
Case 1
If Len(Me!tx2.Text) = 0 Then
filtro = "C.Mes"
p = False
Else
filtro = "A.des_Documento"
End If
Call fCarregaLista(filtro, Me!tx2.Text, "A.des_status", Me!Quadro)
Case 2
If Len(Me!tx2.Text) = 0 Then
filtro = "C.Mes"
p = False
Else
filtro = "A.rec_Documento"
End If
Call fCarregaLista(filtro, Me!tx2.Text, "A.rec_status", Me!Quadro)
End Select
Call fSomaLista(p)
End Sub
Private Sub tx2_GotFocus()
On Error Resume Next
Me!lista.Value = -1
Call fcor(Me!tx2, "am")
End Sub
Private Sub tx2_LostFocus()
On Error Resume Next
Call fcor(Me!tx2, "br")
Me!tx2 = Null
End Sub
Private Sub tx3_Change()
On Error Resume Next
Dim filtro As String, p As Boolean
p = True
Select Case Me!Moldura
Case 1
If Len(Me!tx3.Text) = 0 Then
filtro = "C.Mes"
p = False
Else
filtro = "A.des_Valor"
End If
Call fCarregaLista(filtro, Me!tx3.Text, "A.des_status", Me!Quadro)
Case 2
If Len(Me!tx3.Text) = 0 Then
filtro = "C.Mes"
p = False
Else
filtro = "A.rec_Valor"
End If
Call fCarregaLista(filtro, Me!tx3.Text, "A.rec_status", Me!Quadro)
End Select
Call fSomaLista(p)
End Sub
Private Sub tx3_GotFocus()
On Error Resume Next
Me!lista.Value = -1
Call fcor(Me!tx3, "am")
End Sub
Private Sub tx3_LostFocus()
On Error Resume Next
Call fcor(Me!tx3, "br")
Me!tx3 = Null
End Sub
Private Sub tx4_Change()
On Error Resume Next
Dim filtro As String, p As Boolean
p = True
Select Case Me!Moldura
Case 1
If Len(Me!tx4.Text) = 0 Then
filtro = "C.Mes"
p = False
Else
filtro = "A.des_Forma"
End If
Call fCarregaLista(filtro, Me!tx4.Text, "A.des_status", Me!Quadro)
Case 2
If Len(Me!tx4.Text) = 0 Then
filtro = "C.Mes"
p = False
Else
filtro = "A.Rec_Forma"
End If
Call fCarregaLista(filtro, Me!tx4.Text, "A.rec_status", Me!Quadro)
End Select
Call fSomaLista(p)
End Sub
Private Sub tx4_GotFocus()
On Error Resume Next
Me!lista.Value = -1
Call fcor(Me!tx4, "am")
End Sub
Private Sub tx4_LostFocus()
On Error Resume Next
Call fcor(Me!tx4, "br")
Me!tx4 = Null
End Sub
Private Sub tx5_Change()
On Error Resume Next
Dim j As Byte, filtro As String, p As Boolean
j = 0: p = True
If Not IsNull(Me!tx1) Then j = j + 1
If Not IsNull(Me!tx6) Then j = j + 2
If Not IsNull(Me!tx7) Then j = j + 4
Select Case j
Case 0
If Me!Moldura = 1 Then
Call fCarregaLista("A.des_Dia", Me!tx5.Text, "A.des_status", Me!Quadro)
Else
Call fCarregaLista("A.rec_Dia", Me!tx5.Text, "A.rec_status", Me!Quadro)
End If
If Len(Me!tx5.Text) = 0 Then p = False
Case 1
If Me!Moldura = 1 Then
filtro = "A.Des_Descrição Like '" & Me!tx1 & "*' AND A.Des_Dia"
Call fCarregaLista(filtro, Me!tx5.Text, "A.des_status", Me!Quadro)
Else
filtro = "A.Rec_Descrição Like '" & Me!tx1 & "*' AND A.Rec_Dia"
Call fCarregaLista(filtro, Me!tx5.Text, "A.rec_status", Me!Quadro)
End If
Case 2
If Me!Moldura = 1 Then
filtro = "C.Mes Like '" & Me!tx6 & "*' AND A.Des_Dia"
Call fCarregaLista(filtro, Me!tx5.Text, "A.des_status", Me!Quadro)
Else
filtro = "C.Mes Like '" & Me!tx6 & "*' AND A.Rec_Dia"
Call fCarregaLista(filtro, Me!tx5.Text, "A.rec_status", Me!Quadro)
End If
Case 4
If Me!Moldura = 1 Then
filtro = "B.Ano Like '" & Me!tx7 & "*' AND A.Des_Dia"
Call fCarregaLista(filtro, Me!tx5.Text, "A.des_status", Me!Quadro)
Else
filtro = "B.Ano Like '" & Me!tx7 & "*' AND A.Rec_Dia"
Call fCarregaLista(filtro, Me!tx5.Text, "A.rec_status", Me!Quadro)
End If
Case 3
If Me!Moldura = 1 Then
filtro = "A.Des_Descrição Like '" & Me!tx1 & "*' AND C.Mes Like '" & Me!tx6 & "*' AND A.Des_Dia"
Call fCarregaLista(filtro, Me!tx5.Text, "A.des_status", Me!Quadro)
Else
filtro = "A.Rec_Descrição Like '" & Me!tx1 & "*' AND C.Mes Like '" & Me!tx6 & "*' AND A.Rec_Dia"
Call fCarregaLista(filtro, Me!tx5.Text, "A.rec_status", Me!Quadro)
End If
Case 5
If Me!Moldura = 1 Then
filtro = "A.Des_Descrição Like '" & Me!tx1 & "*' AND B.Ano Like '" & Me!tx7 & "*' AND A.Des_Dia"
Call fCarregaLista(filtro, Me!tx5.Text, "A.des_status", Me!Quadro)
Else
filtro = "A.Rec_Descrição Like '" & Me!tx1 & "*' AND B.Ano Like '" & Me!tx7 & "*' AND A.Rec_Dia"
Call fCarregaLista(filtro, Me!tx5.Text, "A.rec_status", Me!Quadro)
End If
Case 6
If Me!Moldura = 1 Then
filtro = "C.Mes Like '" & Me!tx6 & "*' AND B.Ano Like '" & Me!tx7 & "*' AND A.Des_Dia"
Call fCarregaLista(filtro, Me!tx5.Text, "A.des_status", Me!Quadro)
Else
filtro = "C.Mes Like '" & Me!tx6 & "*' AND B.Ano Like '" & Me!tx7 & "*' AND A.Rec_Dia"
Call fCarregaLista(filtro, Me!tx5.Text, "A.rec_status", Me!Quadro)
End If
Case 7
If Me!Moldura = 1 Then
filtro = "A.Des_Descrição Like '" & Me!tx1 & "*' AND B.Ano Like '" & Me!tx7 & "*' AND C.Mes Like '" & Me!tx6 & "*' AND A.Des_Dia"
Call fCarregaLista(filtro, Me!tx5.Text, "A.des_status", Me!Quadro)
Else
filtro = "A.Rec_Descrição Like '" & Me!tx1 & "*' AND B.Ano Like '" & Me!tx7 & "*' AND C.Mes Like '" & Me!tx6 & "*' AND A.Rec_Dia"
Call fCarregaLista(filtro, Me!tx5.Text, "A.rec_status", Me!Quadro)
End If
End Select
Call fSomaLista(p)
End Sub
Private Sub tx5_GotFocus()
On Error Resume Next
Me!lista.Value = -1
Call fcor(Me!tx5, "am")
End Sub
Private Sub Tx5_LostFocus()
On Error Resume Next
Call fcor(Me!tx5, "br")
End Sub
Private Sub tx6_Change()
On Error Resume Next
Dim j As Byte, filtro As String, p As Boolean
j = 0: p = True
If Not IsNull(Me!tx1) Then j = j + 1
If Not IsNull(Me!tx5) Then j = j + 2
If Not IsNull(Me!tx7) Then j = j + 4
Select Case j
Case 0
If Me!Moldura = 1 Then
Call fCarregaLista("C.Mes", Me!tx6.Text, "A.des_status", Me!Quadro)
Else
Call fCarregaLista("C.Mes", Me!tx6.Text, "A.rec_status", Me!Quadro)
End If
If Len(Me!tx6.Text) = 0 Then p = False
Case 1
If Me!Moldura = 1 Then
filtro = "A.Des_Descrição Like '" & Me!tx1 & "*' AND C.Mes"
Call fCarregaLista(filtro, Me!tx6.Text, "A.des_status", Me!Quadro)
Else
filtro = "A.Rec_Descrição Like '" & Me!tx1 & "*' AND C.Mes"
Call fCarregaLista(filtro, Me!tx6.Text, "A.rec_status", Me!Quadro)
End If
Case 2
If Me!Moldura = 1 Then
filtro = "A.Des_dia Like '" & Me!tx5 & "*' AND C.Mes"
Call fCarregaLista(filtro, Me!tx6.Text, "A.des_status", Me!Quadro)
Else
filtro = "A.Rec_dia Like '" & Me!tx5 & "*' AND C.Mes"
Call fCarregaLista(filtro, Me!tx6.Text, "A.rec_status", Me!Quadro)
End If
Case 4
filtro = "B.Ano Like '" & Me!tx7 & "*' AND C.Mes"
If Me!Moldura = 1 Then
Call fCarregaLista(filtro, Me!tx6.Text, "A.des_status", Me!Quadro)
Else
Call fCarregaLista(filtro, Me!tx6.Text, "A.rec_status", Me!Quadro)
End If
Case 3
If Me!Moldura = 1 Then
filtro = "A.Des_Descrição Like '" & Me!tx1 & "*' AND A.Des_dia Like '" & Me!tx5 & "*' AND C.Mes"
Call fCarregaLista(filtro, Me!tx6.Text, "A.des_status", Me!Quadro)
Else
filtro = "A.Rec_Descrição Like '" & Me!tx1 & "*' AND A.Rec_dia Like '" & Me!tx5 & "*' AND C.Mes"
Call fCarregaLista(filtro, Me!tx6.Text, "A.rec_status", Me!Quadro)
End If
Case 5
If Me!Moldura = 1 Then
filtro = "A.Des_Descrição Like '" & Me!tx1 & "*' AND B.Ano Like '" & Me!tx7 & "*' AND C.Mes"
Call fCarregaLista(filtro, Me!tx6.Text, "A.des_status", Me!Quadro)
Else
filtro = "A.Rec_Descrição Like '" & Me!tx1 & "*' AND B.Ano Like '" & Me!tx7 & "*' AND C.Mes"
Call fCarregaLista(filtro, Me!tx6.Text, "A.rec_status", Me!Quadro)
End If
Case 6
If Me!Moldura = 1 Then
filtro = "A.Des_dia Like '" & Me!tx5 & "*' AND B.Ano Like '" & Me!tx7 & "*' AND C.Mes"
Call fCarregaLista(filtro, Me!tx6.Text, "A.des_status", Me!Quadro)
Else
filtro = "A.Rec_dia Like '" & Me!tx5 & "*' AND B.Ano Like '" & Me!tx7 & "*' AND C.Mes"
Call fCarregaLista(filtro, Me!tx6.Text, "A.rec_status", Me!Quadro)
End If
Case 7
If Me!Moldura = 1 Then
filtro = "A.Des_Descrição Like '" & Me!tx1 & "*' AND B.Ano Like '" & Me!tx7 & "*' AND A.Des_dia Like '" & Me!tx5 & "*' AND C.Mes"
Call fCarregaLista(filtro, Me!tx6.Text, "A.des_status", Me!Quadro)
Else
filtro = "A.Rec_Descrição Like '" & Me!tx1 & "*' AND B.Ano Like '" & Me!tx7 & "*' AND A.Rec_dia Like '" & Me!tx5 & "*' AND C.Mes"
Call fCarregaLista(filtro, Me!tx6.Text, "A.rec_status", Me!Quadro)
End If
End Select
Call fSomaLista(p)
End Sub
Private Sub tx6_GotFocus()
On Error Resume Next
Me!lista.Value = -1
Call fcor(Me!tx6, "am")
End Sub
Private Sub Tx6_LostFocus()
On Error Resume Next
Call fcor(Me!tx6, "br")
End Sub
Private Sub tx7_Change()
On Error Resume Next
Dim j As Byte, filtro As String, p As Boolean
j = 0: p = True
If Not IsNull(Me!tx1) Then j = j + 1
If Not IsNull(Me!tx5) Then j = j + 2
If Not IsNull(Me!tx6) Then j = j + 4
Select Case j
Case 0
If Me!Moldura = 1 Then
Call fCarregaLista("B.Ano", Me!tx7.Text, "A.des_status", Me!Quadro)
Else
Call fCarregaLista("B.Ano", Me!tx7.Text, "A.rec_status", Me!Quadro)
End If
If Len(Me!tx7.Text) = 0 Then p = False
Case 1
If Me!Moldura = 1 Then
filtro = "A.Des_Descrição Like '" & Me!tx1 & "*' AND B.Ano"
Call fCarregaLista(filtro, Me!tx7.Text, "A.des_status", Me!Quadro)
Else
filtro = "A.Rec_Descrição Like '" & Me!tx1 & "*' AND B.Ano"
Call fCarregaLista(filtro, Me!tx7.Text, "A.rec_status", Me!Quadro)
End If
Case 2
If Me!Moldura = 1 Then
filtro = "A.Des_dia Like '" & Me!tx5 & "*' AND B.Ano"
Call fCarregaLista(filtro, Me!tx7.Text, "A.des_status", Me!Quadro)
Else
filtro = "A.Rec_dia Like '" & Me!tx5 & "*' AND B.Ano"
Call fCarregaLista(filtro, Me!tx7.Text, "A.rec_status", Me!Quadro)
End If
Case 4
filtro = "C.Mes Like '" & Me!tx6 & "*' AND B.Ano"
If Me!Moldura = 1 Then
Call fCarregaLista(filtro, Me!tx7.Text, "A.des_status", Me!Quadro)
Else
Call fCarregaLista(filtro, Me!tx7.Text, "A.rec_status", Me!Quadro)
End If
Case 3
If Me!Moldura = 1 Then
filtro = "A.Des_Descrição Like '" & Me!tx1 & "*' AND A.Des_dia Like '" & Me!tx5 & "*' AND B.Ano"
Call fCarregaLista(filtro, Me!tx7.Text, "A.des_status", Me!Quadro)
Else
filtro = "A.Rec_Descrição Like '" & Me!tx1 & "*' AND A.Rec_dia Like '" & Me!tx5 & "*' AND B.Ano"
Call fCarregaLista(filtro, Me!tx7.Text, "A.rec_status", Me!Quadro)
End If
Case 5
If Me!Moldura = 1 Then
filtro = "A.Des_Descrição Like '" & Me!tx1 & "*' AND C.Mes Like '" & Me!tx6 & "*' AND B.Ano"
Call fCarregaLista(filtro, Me!tx7.Text, "A.des_status", Me!Quadro)
Else
filtro = "A.Rec_Descrição Like '" & Me!tx1 & "*' AND C.Mes Like '" & Me!tx6 & "*' AND B.Ano"
Call fCarregaLista(filtro, Me!tx7.Text, "A.rec_status", Me!Quadro)
End If
Case 6
If Me!Moldura = 1 Then
filtro = "A.Des_dia Like '" & Me!tx5 & "*' AND C.Mes Like '" & Me!tx6 & "*' AND B.Ano"
Call fCarregaLista(filtro, Me!tx7.Text, "A.des_status", Me!Quadro)
Else
filtro = "A.Rec_dia Like '" & Me!tx5 & "*' AND C.Mes Like '" & Me!tx6 & "*' AND B.Ano"
Call fCarregaLista(filtro, Me!tx7.Text, "A.rec_status", Me!Quadro)
End If
Case 7
If Me!Moldura = 1 Then
filtro = "A.Des_Descrição Like '" & Me!tx1 & "*' AND C.Mes Like '" & Me!tx6 & "*' AND A.Des_dia Like '" & Me!tx5 & "*' AND B.Ano"
Call fCarregaLista(filtro, Me!tx7.Text, "A.des_status", Me!Quadro)
Else
filtro = "A.Rec_Descrição Like '" & Me!tx1 & "*' AND C.Mes Like '" & Me!tx6 & "*' AND A.Rec_dia Like '" & Me!tx5 & "*' AND B.Ano"
Call fCarregaLista(filtro, Me!tx7.Text, "A.rec_status", Me!Quadro)
End If
End Select
Call fSomaLista(p)
End Sub
Private Sub tx7_GotFocus()
On Error Resume Next
Me!lista.Value = -1
Call fcor(Me!tx7, "am")
End Sub
Private Sub Tx7_LostFocus()
On Error Resume Next
Call fcor(Me!tx7, "br")
End Sub
Private Function fLimparConsulta()
Me!tx1 = Null: Me!tx2 = Null: Me!tx3 = Null: Me!tx4 = Null
Me!tx5 = Null: Me!tx6 = Null: Me!tx7 = Null: Me!tx8 = Null: Me!ValorLista = Null
Select Case Me!Moldura
Case 1
Call fCarregaLista("A.des_Descrição", "*", "A.des_status", Me!Quadro)
Case 2
Call fCarregaLista("A.rec_Descrição", "*", "A.Rec_status", Me!Quadro)
End Select
Me!tx1.SetFocus
End Function
Private Function fSomaLista(xSoma As Boolean)
On Error Resume Next
If xSoma = False Then
Me!ValorLista = Null
Exit Function
End If
Dim K As Long, xValor As Double
For K = 0 To Me!lista.ListCount - 1
xValor = xValor + Me!lista.Column(6, K)
Next
Me!ValorLista = xValor
End Function