MaximoAccess

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

Obrigado

Administração do MaximoAccess

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

    Formulario de pesquisa

    Compartilhe

    glenioluiz
    Novato
    Novato

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 8
    Registrado : 20/03/2017

    Formulario de pesquisa

    Mensagem  glenioluiz em Qua 19 Abr 2017, 14:57

    Pessoal.

    Estou fazendo um pequeno programa para geração de recibos e preciso colocar um campo novo de consulta, que é consultar CPF.
    Então dentro do formulario de pesquisa tenho dois campos que consulta pelo numero de recibo e pelo valor.
    Ao tentar colocar um campo de pesquisa pelo CPF, nã consigo realizar nenhum filtro ou seja: pode digitar qualquer valor no campo mas não recebo nenhuma resposta-filtro.
    Abaixo está os comandos em VB que utilizei.
    Ressalto que utilizei um formato pronto para essa consulta pois, entendo muito pouco de VB (apesar que acho ele excelente).

    Obrigado.

    Private Sub Listarecibo_DblClick(Cancel As Integer)
       
       DoCmd.OpenForm "frmRecibo", acNormal, "", "[idrecibo]=[forms]![frmpesquisa]![listarecibo]", , acWindowNormal
       DoCmd.Close acForm, "frmPesquisa"
    End Sub
    Private Sub Txtpesquisacod_AfterUpdate()
       Me.Listarecibo.Requery
    End Sub
    Private Sub Txtpesquisacod_Change()
       Me.Recalc
       Me.Txtpesquisacod.SetFocus
       SendKeys "{F2}"
    End Sub
    Private Sub Txtpesquisavalor_AfterUpdate()
       Me.Listarecibo.Requery
    End Sub
    Private Sub Txtpesquisavalor_Change()
       Me.Recalc
       Me.Txtpesquisavalor.SetFocus
       SendKeys "{F2}"
    End Sub
    Private Sub Txtpesquisacpf_AfterUpdate()
       Me.Listarecibo.SetFocus
    End Sub
    Private Sub Txtpesquisacpf_Change()
       Me.Recalc
       Me.txtpesquisacpf.SetFocus
       SendKeys "{F2}"
    End Sub
    Anexos
    recibo_2.jpg
    Você não tem permissão para fazer download dos arquivos anexados.
    (40 Kb) Baixado 9 vez(es)
    avatar
    irmessiasrf
    Novato
    Novato

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 17
    Registrado : 22/04/2016

    Re: Formulario de pesquisa

    Mensagem  irmessiasrf em Dom 23 Abr 2017, 02:53

    Tente fazer dessa madeira:

    Código:
    Private Sub SeuCampodePesquisa_Change()
           lstArea.RowSource = "SELECT * FROM SuaTabela Where CampodaTabelaaSerPesquisado Like '*" & TodosAcentos(SeuCampodePesquisa.Text) & "*' Order By CampodaTabelaaSerOrdenado;"
    End sub
    "

    Caso você venha a realizar alguma pesquisa utilizando campo onde exista texto com letras acentuadas, encontrei aqui no Forum uma ótima função que ignorar a acentuação ao pesquisar com o seguinte código:

    Código:
    Public Function TodosAcentos(pstrPlain As String) As String
      Const cAlphabet _
          = "aáàâäãå¦" _
          & "cç¦" _
          & "dð¦" _
          & "eéèêë¦" _
          & "f?¦" _
          & "iíìîï¦" _
          & "nñ¦" _
          & "oóòôöõø¦" _
          & "saߦ" _
          & "uúùûü¦" _
          & "yýÿ¦" _
          & "z~"
      
      Dim strAcc() As String
      Dim strLike As String
      Dim intN As Integer
      Dim strP As Integer
      Dim strC As String
      
      strAcc = Split(cAlphabet, "¦")
      For strP = 1 To Len(pstrPlain)
          strC = Mid$(pstrPlain, strP, 1)
          For intN = LBound(strAcc) To UBound(strAcc)
              If InStr(strAcc(intN), strC) = 1 Then
                  strC = "[" & strAcc(intN) & "]"
                  Exit For
              End If
          Next intN
          strLike = strLike & strC
      Next strP
      
      TodosAcentos = strLike
      
    End Function

    glenioluiz
    Novato
    Novato

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 8
    Registrado : 20/03/2017

    Re: Formulario de pesquisa

    Mensagem  glenioluiz em Seg 24 Abr 2017, 12:43

    Obrigado.
    Vou testar e caso haja algum problema, relatarei aqui.
    Valeu pela ajuda!
    Espero poder colaborar também, partilhando o que aprendi.

      Data/hora atual: Seg 25 Set 2017, 10:41