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] Ignorar acentos, espaço e vírgulas em registos duplicados

    Compartilhe
    avatar
    alpedro
    Intermediário
    Intermediário

    Respeito às Regras 100%

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

    [Resolvido] Ignorar acentos, espaço e vírgulas em registos duplicados

    Mensagem  alpedro em Ter 26 Abr 2016, 15:38

    Olá.
    Tenho este código numa BD que vi num tópico:
    [Você precisa estar registrado e conectado para ver este link.]

    Private Sub EMPRESA_BeforeUpdate(Cancel As Integer)
    On Error GoTo Err_EMPRESA_BeforeUpdate

    Dim Mess As String
    'set a variavel recordset
    Dim Tabela As Recordset
    Set Tabela = Me.RecordsetClone

    With Tabela
    'verifica se o cliente já está Inserido
    .FindFirst "EMPRESA= '" & Me.EMPRESA & "'"
    'se encontrou então
    If Not .NoMatch Then
    Cancel = True
    'Desfaz registro, não é novo

    Mess = MsgBox("Esta EMPRESA já existe, quer alterar os dados?", vbQuestion + vbYesNo, "Aviso")

    If Mess = vbYes Then
    Me.Undo 'desfaz a digitação.
    ' MsgBox "EMPRESA selecionada !", vbInformation, "Aviso"
    Me.Bookmark = .Bookmark
    'exibe o registro já Registado

    ElseIf Mess = vbNo Then
    Ok = MsgBox("Adicionar nova empresa " & EMPRESA & " ?", vbQuestion + vbYesNo, "")
    If Ok = vbYes Then
    Cancel = False ' registo mantem-se
    ElseIf Ok = vbNo Then
    DoCmd.Close acForm, "CONTACTOS"
    End If

    'Sai da SUB
    Exit Sub
    End If

    End If
    End With

    Set Tabela = Nothing
    Err_EMPRESA_BeforeUpdate:
    Exit Sub
    End Sub

    e então verifica se há nome Empresa duplicado e queria que ignorasse acentos, espaço e vírgulas , através de:

    Replace(Replace(Replace(Replace(Replace(Replace(Replace(Tabela!EMPRESA, "á", "a"), "é", "e"), "í", "i"), "ó", "o"), "ú", "u"), " ", ""), ",", "") = Replace(Replace(Replace(Replace(Replace(Replace(Replace(Me.EMPRESA, "á", "a"), "é", "e"), "í", "i"), "ó", "o"), "ú", "u"), " ", ""), ",", "")

    como no tópico: [Você precisa estar registrado e conectado para ver este link.]
    como faço?


    Última edição por alpedro em Qua 27 Abr 2016, 01:23, editado 5 vez(es)
    avatar
    Avelino Sampaio
    Moderador
    Moderador

    Respeito às Regras 100%

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

    Re: [Resolvido] Ignorar acentos, espaço e vírgulas em registos duplicados

    Mensagem  Avelino Sampaio em Ter 26 Abr 2016, 17:03

    Olá!

    Veja se esta alternativa ajuda:

    [Você precisa estar registrado e conectado para ver este link.]

    Sucesso!


    avatar
    alpedro
    Intermediário
    Intermediário

    Respeito às Regras 100%

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

    Re: [Resolvido] Ignorar acentos, espaço e vírgulas em registos duplicados

    Mensagem  alpedro em Ter 26 Abr 2016, 19:26

    Não consegui melhor....
    avatar
    alpedro
    Intermediário
    Intermediário

    Respeito às Regras 100%

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

    Re: [Resolvido] Ignorar acentos, espaço e vírgulas em registos duplicados

    Mensagem  alpedro em Ter 26 Abr 2016, 21:20

    tentei com esta função que funciona bem para uma só palavra, com empresa com 2 ou mais palavras não deu:

    'Tira acentos e espaços de uma string, transformado-a em minúscula
    Function Ascentos(StrTrata)
    r = ""
    V_A = "áÁãÃäÄàÀâÂ"
    V_E = "éÉèÈëËÊê"
    V_I = "íÍìÌïÏîÎ"
    V_O = "óÓòÒõÕÖöôÔ"
    V_U = "úÚùÙüÜûÛ"
    StrTrata = CStr(StrTrata)
    For aux = 1 To Len(StrTrata)
    L = Mid(StrTrata, aux, 1)
    If (InStr(V_A, L) <> 0) Then L = "a"
    If (InStr(V_E, L) <> 0) Then L = "e"
    If (InStr(V_I, L) <> 0) Then L = "i"
    If (InStr(V_O, L) <> 0) Then L = "o"
    If (InStr(V_U, L) <> 0) Then L = "u"
    If (L = " ") Then L = ""
    r = r + LCase(L)
    Next
    Ascentos = r
    End Function

    avatar
    Avelino Sampaio
    Moderador
    Moderador

    Respeito às Regras 100%

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

    Re: [Resolvido] Ignorar acentos, espaço e vírgulas em registos duplicados

    Mensagem  Avelino Sampaio em Ter 26 Abr 2016, 21:31

    Veja também a minha dica 68

    [Você precisa estar registrado e conectado para ver este link.]

    Sucesso!
    avatar
    alpedro
    Intermediário
    Intermediário

    Respeito às Regras 100%

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

    Re: [Resolvido] Ignorar acentos, espaço e vírgulas em registos duplicados

    Mensagem  alpedro em Ter 26 Abr 2016, 22:22

    .FindFirst "EMPRESA= '" & StrConv(Me!EMPRESA, 2, 1049) & "'"

    e como resolver os espaços e vírgulas?


    Última edição por alpedro em Qua 27 Abr 2016, 08:14, editado 1 vez(es)
    avatar
    XPTOS
    Super Avançado
    Super Avançado

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 545
    Registrado : 20/01/2014

    Re: [Resolvido] Ignorar acentos, espaço e vírgulas em registos duplicados

    Mensagem  XPTOS em Qua 27 Abr 2016, 02:09


    Veja este tópico, pode te ajudar.

    [Você precisa estar registrado e conectado para ver este link.]
    avatar
    Avelino Sampaio
    Moderador
    Moderador

    Respeito às Regras 100%

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

    Re: [Resolvido] Ignorar acentos, espaço e vírgulas em registos duplicados

    Mensagem  Avelino Sampaio em Qua 27 Abr 2016, 12:18

    Olá!

    Experimente:

    .FindFirst "StrConv(Replace(Replace(Empresa, ' ', ''), ',', ''), 2, 1049) = '" & StrConv(Replace(Replace(Me.Empresa, " ", ""), ",", ""), 2, 1049) & "'"

    Aguardamos
    avatar
    alpedro
    Intermediário
    Intermediário

    Respeito às Regras 100%

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

    Re: [Resolvido] Ignorar acentos, espaço e vírgulas em registos duplicados

    Mensagem  alpedro em Qua 27 Abr 2016, 12:54

    Olá.
    Está ok. Pus também o ponto , ".", "")
    Obrigado a ajuda e ensinamento
    Very Happy
    avatar
    alpedro
    Intermediário
    Intermediário

    Respeito às Regras 100%

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

    Re: [Resolvido] Ignorar acentos, espaço e vírgulas em registos duplicados

    Mensagem  alpedro em Qui 28 Abr 2016, 13:29

    Olá. Reabri o tópico porque na minha BD se clicar adicionar um contacto é avisado se aquela empresa já existe de acordo com o código acima.
    Mas se for ao form FILTRAR e pedir para abrir o contacto da empresa que esteja a ver e depois pedir para (botão) ADICIONAR nova empresa no form CONTACTOS, o código acima não tem efeito, ou seja, adiciono uma empresa já existente e não há aviso algum de que já existe.

    Tenho no subformulário subformA do form FILTRAR, o seguinte código para abrir o contacto da empresa que esteja a ver :
    Private Sub EMPRESA_Click()
    If EMPRESA > 0 Then
    DoCmd.OpenForm "CONTACTOS", , , "[CÓDIGO]=" & Me.CÓDIGO
    Else
    MsgBox ("selecione uma EMPRESA"), vbInformation
    End If
    End Sub

    Tem influência?

    Ao clicar numa EMPRESA no form FILTRAR, abre o form CONTACTOS no contacto da empresa que esteja a ver e se clicar botão ADICIONAR o código EMPRESA_BeforeUpdate não tem efeito.
    Como corrigir?

    Obrigado.
    avatar
    alpedro
    Intermediário
    Intermediário

    Respeito às Regras 100%

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

    Re: [Resolvido] Ignorar acentos, espaço e vírgulas em registos duplicados

    Mensagem  alpedro em Qui 28 Abr 2016, 20:19

    Fiz assim:

    Private Sub botão_adicionar_Click()

    If [CÓDIGO] = Me.CÓDIGO And Not [CÓDIGO] = 0 Then
    DoCmd.Close
    DoCmd.OpenForm "CONTACTOS"

    Else

    Form.Requery
    DoCmd.GoToRecord , , acNewRec
    ....

      Data/hora atual: Qui 14 Dez 2017, 04:23