[Resolvido]Se não estiver na lista

Boa noite Amigos

É com este código abaixo que utilizo para a função " Se não estiver na lista". E funciona perfeito

Código:

Private Sub Cliente_NotInList(NewData As String, Response As Integer)

Dim SQL As String
Dim Contribuinte As String
Dim Cidade As String
DoCmd.SetWarnings False
If MsgBox("Cliente " & Proper(NewData) & " Não Registado" & vbCrLf & "Deseja Registar o Cliente " & "Agora ?", vbInformation + vbYesNo, "Aviso") = vbYes Then
SQL = "INSERT INTO Clientes (Nome) VALUES ('" & Proper(NewData) & "')"
DoCmd.RunSQL SQL
Contribuinte = InputBox("Qual é o Nº de Contribuinte ?", "Contribuinte")
CurrentDb.Execute "UPDATE Clientes SET Contribuinte = ('" & Format(Contribuinte, "### ### ###") & "') WHERE '" & Proper(NewData) & "' = nome"
Cidade = InputBox("Qual é a Cidade ?", "Cidade")
CurrentDb.Execute "UPDATE Clientes SET Cidade = ('" & Proper(Cidade) & "') WHERE '" & Proper(NewData) & "' = nome"
Response = acDataErrAdded
Else
Response = acDataErrDisplay
End If
DoCmd.SetWarnings True

End Sub


Mas queria aprimorar o mesmo para detetar quando o Nº de Contribuinte já está registado na tabela e avisar.

Onde meter o código que está aqui em baixo no código que está acima ?

Código:

'==============================
If (Not IsNull(DLookup("[Contribuinte]", "Clientes", "[Contribuinte] ='" & Me!txtContribuinte & "'"))) Then
       MsgBox "O Nº de Contribuinte " & txtContribuinte & " Já Existe na Tabela de Clientes.", vbInformation, "Aviso"
       Me.txtContribuinte.SetFocus
        Me.txtContribuinte = Null
       Exit Sub
       End If
'====================================

Obrigado

Que tal aqui:


Private Sub Cliente_NotInList(NewData As String, Response As Integer)

Dim SQL As String
Dim Contribuinte As String
Dim Cidade As String
DoCmd.SetWarnings False
If MsgBox("Cliente " & Proper(NewData) & " Não Registado" & vbCrLf & "Deseja Registar o Cliente " & "Agora ?", vbInformation + vbYesNo, "Aviso") = vbYes Then
SQL = "INSERT INTO Clientes (Nome) VALUES ('" & Proper(NewData) & "')"
DoCmd.RunSQL SQL
Contribuinte = InputBox("Qual é o Nº de Contribuinte ?", "Contribuinte")

If (Not IsNull(DLookup("[Contribuinte]", "Clientes", "[Contribuinte] ='" & Contribuinte & "'"))) Then
MsgBox "O Nº de Contribuinte " & Contribuinte & " Já Existe na Tabela de Clientes.", vbInformation, "Aviso"
Me.txtContribuinte.SetFocus
Me.txtContribuinte = Null
Exit Sub
else
CurrentDb.Execute "UPDATE Clientes SET Contribuinte = ('" & Format(Contribuinte, "### ### ###") & "') WHERE '" & Proper(NewData) & "' = nome"
Cidade = InputBox("Qual é a Cidade ?", "Cidade")
CurrentDb.Execute "UPDATE Clientes SET Cidade = ('" & Proper(Cidade) & "') WHERE '" & Proper(NewData) & "' = nome"
Response = acDataErrAdded
end if
Else
Response = acDataErrDisplay
End If
DoCmd.SetWarnings True

End Sub

O Contribuinte Destacado em vermelho se refere a Variável que recebe o Valor da InputBox ta. Talvez seja melhor mudar o nome dela.

Estou partindo da Ideia de que apos O InputBox, vc quer verificar se o Contribuinte existe mesmo, se nao for isso detalhe melhor sua duvida!

Bom dia Fabio

A Intenção é mesmo impedir repetir Nº contribuinte na tabela

Alterei Contribuinte para NContribuinte.

Só tem um formulário, e é no campo "Cliente"

Mas não funciona .... por favor teste, na tabela já tem um cliente com o número de contribuinte nº 123123123

Assis, fiquei confuso, voce pretende colocar um codigo de avisa que ja existe na tabela no evento se nao esta na lista?

Mas de qualquer forma teste colocando o codigo de alerta existencia no evento "ao alterar".

Tauron bom dia

O evento se não estiver na lista, é para quando se digita numa caixa de combinação um dado novo.

Neste caso o dado novo é o campo "Nome" da tabela que em 3 campos para preencher. Nome, Contribuinte e Cidade

O método que eu uso é por inputbox (Não abre nenhum formulário novo).

Assim que digito um nome que não está na tabela ele grava e pede de seguida para digitar o Nº Contribuinte.

Acontece que se por erro de digitação ou por outro motivo, se o numero digitado já estiver na tabela .... Quero ser avisado para assim não continuar.


Obrigado

Olha se ajuda:

Tauron

Testou ?

Não consigo gravar Nºs Contribuinte novos nem repetidos.

Que alteração é que fez?

Obrigado

Arquivo errado.

Pois
Gravou o nome, mas o contribuinte não grava.

Mas já agora teste ...

Nome cliente

Mário

E Contribuinte 555 555 555


---------------------------------
Devia deixar o contribuinte 555 555 555 não está na tabela

Não estou entendendo, aqui ta gravando. Alias se voce observar o codigo eh o seu original no evento "se nao estiver na lista". Apenas coloquei um codigo no evento "antes de atualizar".

Tauron

Mas grava na tabela e não devia ....

Olá a todos,

Assis, teste assim:

Código:

Private Sub Cliente_NotInList(NewData As String, Response As Integer)
Dim SQL As String
Dim NContribuinte As String
Dim Cidade As String
DoCmd.SetWarnings False

If MsgBox("Cliente " & Proper(NewData) & " Não Registado" & vbCrLf & "Deseja Registar o Cliente " & "Agora ?", vbInformation + vbYesNo, "Aviso") = vbYes Then
    
    NContribuinte = InputBox("Qual é o Nº de Contribuinte ?", "Contribuinte")
    
    If DCount("Contribuinte", "Clientes", "Contribuinte = '" & Format(NContribuinte, "### ### ###") & "'" & "") > 0 Then
        MsgBox "O Nº de Contribuinte " & NContribuinte & " Já Existe na Tabela de Clientes.", vbInformation, "Aviso"
        Exit Sub
    Else
        SQL = "INSERT INTO Clientes (Nome) VALUES ('" & Proper(NewData) & "')"
        DoCmd.RunSQL SQL
        
        CurrentDb.Execute "UPDATE Clientes SET Contribuinte = ('" & Format(NContribuinte, "### ### ###") & "') WHERE '" & Proper(NewData) & "' = nome"
        Cidade = InputBox("Qual é a Cidade ?", "Cidade")
        CurrentDb.Execute "UPDATE Clientes SET Cidade = ('" & Proper(Cidade) & "') WHERE '" & Proper(NewData) & "' = nome"
        Response = acDataErrAdded
    End If
Else
    Response = acDataErrDisplay
End If

DoCmd.SetWarnings True

End Sub


Assis, onde anda a Indentação, pedido de 2018

Abraço a todos

Boa Teixeira

Obrigado

A indentação vai mesmo ter de ser iniciada. Mas como a maior parte dos códigos estão numa BD que é quase sempre copiar e colar ... que esquece.

Olá Assis,

Obrigado pelo retorno.
Quanto à indentação, quando inicia alguma alteração no código antes de inciar faz a indentação dessa sub, vai ver que daqui a uns tempos já tem grande parte feita.
Além disso, ajuda a compreender e ler melhor o código.

Abraço

Me desculpem por postar aqui mas, estou tentando adaptar o codigo e nao estou conseguindo

Olá Tauron,

O anexo da mensagem nº 15 apresenta erros de compilação.
Ajuste o código ou as referências em falta.
Depois poste de novo.

Nota: Atualize anexo da mensagem nº 15, caso poste em mensagem nova, elimine o anexo anterior.
Desta forma poupamos espaço para anexos do fórum que está curto e é pago

Abraço a todos

Arquivo da mensagem 15 atualizado

Olá Tauron,

Altere o parametro para Sim, que já vai começar a ver o código a executar:


Vai dar erros, será ajusatar se tiver dificuldades avise.
Abraço

Pessoal, apos a mensagem do ahteixeira, procedi as alteracoes mas, no final deu erro 3061 "Parametros Insuficientes. Eram esperados 1", apontando para esta linha:

CurrentDb.Execute "UPDATE tblContribuintes SET Endereco = ('" & Proper(endAdq) & "') WHERE '" & Proper(NewData) & "' = CFPCNPJ"


e ao tentar atualizar o meu arquivo constante da mensagem 15. o Exclui para enviar novamente o atualizado não consegui mais por espaço insuficiente.

Olá Tauron,

Já recoloquei o ficheiro da mensagem nº 15:

Teste com o seguinte código:

Código:

Private Sub CPFCNPJAD_NotInList(NewData As String, Response As Integer)
Dim SQL As String
Dim NContribuinte As String
Dim Endereco As String

    If MsgBox("CPFCNPJAD " & Proper(NewData) & " Não Registado" & vbCrLf & "Deseja Registar o Cliente " & "Agora ?", vbInformation + vbYesNo, "Aviso") = vbYes Then
        NContribuinte = InputBox("Qual é o Nome do Contribuinte ?", "Contribuinte")
        SQL = "INSERT INTO tblContribuintes (CPFCNPJ, Contribuinte) VALUES ('" & Proper(NewData) & "' , '" & NContribuinte & "')"
        DoCmd.RunSQL SQL
        DoEvents
        Response = acDataErrAdded
    Else
        MsgBox "Verifique então o código introduzido, campo obrigatório.", vbCritical, ""
        Exit Sub
    End If

End Sub

Abraço

AhTeixeira, veja bem, eu preciso que caso o que for digitado no campo cpfcnpjad nao estiver na tabela, eu consiga incluir o contribuinte (ncontribuinte) e o endereco. Resumindo, preencher os tres campos, caso ja exista me retornara o Nome e endereco.

Ola Tauron,

Teste assim:

Código:

Private Sub CPFCNPJAD_NotInList(NewData As String, Response As Integer)
Dim SQL As String
Dim NContribuinte As String
Dim SEndereco As String

    If MsgBox("CPFCNPJAD " & Proper(NewData) & " Não Registado" & vbCrLf & "Deseja Registar o Cliente " & "Agora ?", vbInformation + vbYesNo, "Aviso") = vbYes Then
       
verificaNC:
        NContribuinte = InputBox("Qual é o Nome do Contribuinte ?", "Contribuinte")
            If DCount("Contribuinte", "tblContribuintes", "Contribuinte = '" & NContribuinte & "'") > 0 Then
                MsgBox "Ja existe esse nome de contribuinte, verifique.", vbInformation, ""
                Exit Sub
            End If
verificaSE:
        SEndereco = InputBox("Qual é o Endereço ?", "Endereco")
       
        'verifica se campos estao vazios
        If Len(NContribuinte & "") = 0 Then
            MsgBox "Nome contribuinte nao pode ser vazio, verifique", vbCritical, ""
            GoTo verificaNC
        End If
        If Len(SEndereco & "") = 0 Then
            MsgBox "O endereco nao pode ser vazio, verifique", vbCritical, ""
            GoTo verificaSE
        End If
       
        SQL = "INSERT INTO tblContribuintes (CPFCNPJ, Contribuinte, Endereco) VALUES ('" & Proper(NewData) & "' , '" & NContribuinte & "' , '" & SEndereco & "')"
        DoCmd.RunSQL SQL
        DoEvents
        Response = acDataErrAdded
    Else
        MsgBox "Verifique então o código introduzido, campo obrigatório.", vbCritical, ""
        Exit Sub
    End If

End Sub


Abraco