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

    [Resolvido]chamar função ignorar acentos

    Compartilhe
    avatar
    alpedro
    Intermediário
    Intermediário

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Portugal
    Mensagens : 165
    Registrado : 08/02/2016

    [Resolvido]chamar função ignorar acentos

    Mensagem  alpedro em Ter 08 Mar 2016, 14:23

    Olá.
    Tenho uma BD com um formulário pesquisa, com o seguinte código:
    Option Compare Database
    Option Explicit
    Dim VarEspaco

    Private Sub btn_limpar_Click()
    'botão limpar
    Me.pesquisa_localidade.SetFocus
    Me.pesquisa_localidade.Text = ""
    Me.pesquisa_país.SetFocus
    Me.pesquisa_país.Text = ""
    Me.pesquisa_firma.SetFocus
    Me.pesquisa_firma.Text = ""
    Me.pesquisa_especialidade.SetFocus
    Me.pesquisa_especialidade.Text = ""
    End Sub

    Private Sub Form_Open(Cancel As Integer)
    Me.KeyPreview = True
    Me.lista_especialidade = ""
    DoCmd.Maximize
    End Sub

    Private Sub pesquisa_especialidade_AfterUpdate()
    Me.lista_especialidade.Requery
    End Sub
    Private Sub pesquisa_especialidade_KeyPress(KeyAscii As Integer)
    If KeyAscii = 32 Then
    VarEspaco = 1
    End If
    End Sub
    Private Sub pesquisa_especialidade_Change()
    If VarEspaco = 1 Then
    VarEspaco = 0
    Else
    Me.Recalc
    Me.pesquisa_especialidade.SelStart = 255
    End If
    End Sub

    Private Sub pesquisa_localidade_AfterUpdate()
    Me.lista_especialidade.Requery
    End Sub
    Private Sub pesquisa_localidade_KeyPress(KeyAscii As Integer)
    If KeyAscii = 32 Then
    VarEspaco = 1
    End If
    End Sub
    Private Sub pesquisa_localidade_Change()
    If VarEspaco = 1 Then
    VarEspaco = 0
    Else
    Me.Recalc
    Me.pesquisa_localidade.SelStart = 255
    End If
    End Sub

    Private Sub pesquisa_país_AfterUpdate()
    Me.lista_especialidade.Requery
    End Sub
    Private Sub pesquisa_país_KeyPress(KeyAscii As Integer)
    If KeyAscii = 32 Then
    VarEspaco = 1
    End If
    End Sub
    Private Sub pesquisa_país_Change()
    If VarEspaco = 1 Then
    VarEspaco = 0
    Else
    Me.Recalc
    Me.pesquisa_país.SelStart = 255
    End If
    End Sub

    Private Sub pesquisa_firma_AfterUpdate()
    Me.lista_especialidade.Requery
    End Sub
    Private Sub pesquisa_firma_KeyPress(KeyAscii As Integer)
    If KeyAscii = 32 Then
    VarEspaco = 1
    End If
    End Sub
    Private Sub pesquisa_firma_Change()
    If VarEspaco = 1 Then
    VarEspaco = 0
    Else
    Me.Recalc
    Me.pesquisa_firma.SelStart = 255
    End If
    End Sub

    Tem também o módulo para ignorar a acentuação ao pesquisar com o seguinte 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
     
    Não está a ignorar a acentuação. É preciso chamar a função e como?
    Obrigado.


    Última edição por alpedro em Qua 09 Mar 2016, 04:25, editado 1 vez(es)
    avatar
    FabioPaes
    Moderador
    Moderador

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 3335
    Registrado : 14/08/2013

    Re: [Resolvido]chamar função ignorar acentos

    Mensagem  FabioPaes em Ter 08 Mar 2016, 15:01

    Meu amigo, digamos que esse seu formulario de Pesquisa possua uma caixa de pesquisa de nome txt_nome, e uma Caixa de listagem onde aparecem os nomes digitados....

    Na sua caixa de Listagem, na guia Dados,  Origem da Linha, Clique nos ... (tres pontinho), abrira a consulta....
    Va ate o Campo Onde tem o Critério (Como "*" &...), aqui voce deve chamar depois do * a função TodosAcentos exe:

    Como "*" & TodosAcentos([Forms]![Pesquisa].[txt_nome] & "*")

    So lembranco que:
    Pesquisa é o nome do formulario;
    txt_nome é  a caixa de Listagem que eu digito o nome a ser pesquisado;
    TodosAcentos é o nome da sua Função.
    avatar
    alpedro
    Intermediário
    Intermediário

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Portugal
    Mensagens : 165
    Registrado : 08/02/2016

    Re: [Resolvido]chamar função ignorar acentos

    Mensagem  alpedro em Ter 08 Mar 2016, 15:14

    Obrigado. Funcionou. Smile
    avatar
    FabioPaes
    Moderador
    Moderador

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 3335
    Registrado : 14/08/2013

    Re: [Resolvido]chamar função ignorar acentos

    Mensagem  FabioPaes em Ter 08 Mar 2016, 15:14

    Bacana! bons Estudos!

      Data/hora atual: Ter 26 Set 2017, 06:43