MaximoAccess

Caro Usuário, não tire as suas duvidas nas Salas de Repositório, abra sempre um novo tópico relacionado, nas salas destinadas para o efeito, como Sala de Tabelas, Consultas, Formulários, Relatórios, Macros, Módulos e VBA.

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

    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)

    FabioPaes
    Developer
    Developer

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 2300
    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.

    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

    FabioPaes
    Developer
    Developer

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 2300
    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: Sab 03 Dez 2016, 04:38