MaximoAccess

Caro Usuário, antes de postar pela primeira vez, leia as regras do fórum.

https://www.maximoaccess.com/t48-regras-do-forum

Obrigado

Administração


Participe do fórum, é rápido e fácil

MaximoAccess

Caro Usuário, antes de postar pela primeira vez, leia as regras do fórum.

https://www.maximoaccess.com/t48-regras-do-forum

Obrigado

Administração

MaximoAccess

Gostaria de reagir a esta mensagem? Crie uma conta em poucos cliques ou inicie sessão para continuar.

Dicas Ms Access, Exemplos Ms Access, Codigos VBA Ms Access, SQL Ms Access


2 participantes

    [Resolvido]Acrecentando campo em consulta e corrigindo erros de pesquisa

    avatar
    paulodududuedu
    Intermediário
    Intermediário


    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 57
    Registrado : 19/04/2010

    [Resolvido]Acrecentando campo em consulta e corrigindo erros de pesquisa Empty [Resolvido]Acrecentando campo em consulta e corrigindo erros de pesquisa

    Mensagem  paulodududuedu 22/7/2012, 19:18

    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
    avatar
    paulodududuedu
    Intermediário
    Intermediário


    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 57
    Registrado : 19/04/2010

    [Resolvido]Acrecentando campo em consulta e corrigindo erros de pesquisa Empty Re: [Resolvido]Acrecentando campo em consulta e corrigindo erros de pesquisa

    Mensagem  paulodududuedu 24/7/2012, 16:36

    ninguem ?

    Estou tentando aqui corrigir a consulta mas ainda não obitive exito.

    abraços
    Alexandre Neves
    Alexandre Neves
    Moderador Global
    Moderador Global


    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Portugal
    Mensagens : 8449
    Registrado : 05/11/2009

    [Resolvido]Acrecentando campo em consulta e corrigindo erros de pesquisa Empty Re: [Resolvido]Acrecentando campo em consulta e corrigindo erros de pesquisa

    Mensagem  Alexandre Neves 24/7/2012, 16:47

    Boa tarde, paulo

    O código é tão enrolado que o melhor será executá-lo passo-a-passo (F8) e comparar a evolução do valor das variáveis
    avatar
    paulodududuedu
    Intermediário
    Intermediário


    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 57
    Registrado : 19/04/2010

    [Resolvido]Acrecentando campo em consulta e corrigindo erros de pesquisa Empty Re: [Resolvido]Acrecentando campo em consulta e corrigindo erros de pesquisa

    Mensagem  paulodududuedu 24/7/2012, 17:39

    é verdade ! eu to fazendo isso !

    to fazendo passo a passo e seguindo o modelo do que está funcionando correto.

    o censurado é que são muitas ideias para pouco conhecimento rs...

    ex. hoje estou pensando em adicionar nesse codigo um campo que abilita o valor para ser somado.
    ex. tambem estou querendo fazer com que em um campo filtro eu possa filtar duas ou mais palavras no mesmo campo separando por;

    entre outras coisas.

    No dia que chegar a um termino eu posto aqui !
    enquanto isso vou colhendo informações de um lado de outro e vendo onde chegamos rs...

    mas se alguem ainda estiver disposto em analizar e ver o que conseguimos fazer estamos ai !

    vlw
    Alexandre Neves
    Alexandre Neves
    Moderador Global
    Moderador Global


    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Portugal
    Mensagens : 8449
    Registrado : 05/11/2009

    [Resolvido]Acrecentando campo em consulta e corrigindo erros de pesquisa Empty Re: [Resolvido]Acrecentando campo em consulta e corrigindo erros de pesquisa

    Mensagem  Alexandre Neves 24/7/2012, 17:50

    paulo,
    Só é possível analisar na bd

    Conteúdo patrocinado


    [Resolvido]Acrecentando campo em consulta e corrigindo erros de pesquisa Empty Re: [Resolvido]Acrecentando campo em consulta e corrigindo erros de pesquisa

    Mensagem  Conteúdo patrocinado


      Data/hora atual: 7/5/2024, 21:53