MaximoAccess

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

https://www.maximoaccess.com/t48-regras-do-forum

Obrigado

Administração


Participe do fórum, é rápido e fácil

MaximoAccess

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

https://www.maximoaccess.com/t48-regras-do-forum

Obrigado

Administração

MaximoAccess

Gostaria de reagir a esta mensagem? Crie uma conta em poucos cliques ou inicie sessão para continuar.

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

2 participantes

    Registro duplicando sozinho no evento Onclick ( apenas um clique de mouse ) !!!

    Silvio
    Silvio
    Developer
    Developer


    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 5028
    Registrado : 20/04/2011

    Registro duplicando sozinho no evento Onclick  ( apenas um clique de mouse ) !!! Empty Registro duplicando sozinho no evento Onclick ( apenas um clique de mouse ) !!!

    Mensagem  Silvio 3/11/2022, 10:35

    Prezados, bom dia / boa tarde / boa noite!

    Tenho passado por uma situação atípica em um sistema desenvolvido por mim a 8 anos. De 2 semanas para cá, até a presente data, alguns registros têm se
    duplicado sozinho.

    Não é algo constante, não é sempre na mesma rotina, não é sempre no mesmo formulário.

    Simplesmente se duplicam. O Evento, a rotina estão ao clicar apenas uma vez.

    Já compactei e reparei o Back end e nada. Já compactei e reparei o front end também nos 8 computadores ligados ao Back end, cada um com seu front end.

    Não é sempre o mesmo computador que duplica a rotina.

    Essa situação tem me tirado o sono aqui, já revi a rotina

    Abaixo uma das rotinas, que ora duplica registo...ora não duplica.

    Código:
    Private Sub Dinheiro_Click()
    DoCmd.Save
    On Error Resume Next
    ' caso realize o pagamento em dinheiro....


    If Me.Dinheiro = -1 Then
     If MsgBox("Confirma o pgto em dinheiro ?", vbYesNo, Me.Caption) = vbNo Then
      Me.Dinheiro = 0
      Me.Carteira = 0
      Me.Cheques = 0
      Me.CCredito = 0
      Me.CDebito = 0
      Me.ValorDinheiro = ""
      Exit Sub
      Else
     
     On Error Resume Next
    If IsNull(Me.DataPagamento) Or Me.DataPagamento = "" Then
    MsgBox " Data pagamento é campo obrigatório !", vbCritical, Me.Caption
    Me.Cheques.Value = 0
    Me.Dinheiro.Value = 0
    Exit Sub

    Else
    Call CRM
    '----------------------------------------------------------------------------------------------------------------------------------------------
    'aqui inicio a exportação para o historico de caixa da tabela proprietarios
     Dim strHist As String
     Dim rs As DAO.Recordset
        Set rs = Me.SFrmCaixa.Form.RecordsetClone    'Clono o recorset do subform
        rs.MoveFirst    'Para evitar erros, posiciono o ponteiro do recordset no primeiro registro
        Do Until rs.EOF
        strHist = strHist & "Proc/Med: " & rs!Servico & vbCrLf & _
                            "Valor R$: " & FormatCurrency(rs!Custo) & vbCrLf & _
                            "Qtd    : " & rs!Qtd & vbCrLf & _
                            "Valor Total R$: " & FormatCurrency(rs!Tcusto)

        rs.MoveNext
        Loop
        rs.Close 'Fecho a conexao com recordset
        Set rs = Nothing 'apagado o rs da memória
     

    Dim db7 As Database, rs7 As DAO.Recordset
    Set db7 = CurrentDb
    Set rs7 = db7.OpenRecordset("proprietarios", dbOpenDynaset)
    rs7.FindFirst "idprop  = " & Forms!Frmcaixa!IdProp
    With rs7

    .Edit
     If IsNull(!HistCaixa) Or !HistCaixa = " " Then
      !HistCaixa = !HistCaixa & vbCrLf & "*-*-*-*-*-*-*-*-*-*-*-*-* Dinheiro *-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-"
      !HistCaixa = !HistCaixa & vbCrLf & "DATA: " & Me.DataPagamento & vbCrLf & _
                                          "Mascote:  " & Me.Animal & vbCrLf & _
                                          "Desc.:  " & FormatCurrency(Me.Descontos) & " Total pago:  " & FormatCurrency(Me.Valor) & vbCrLf & strHist
                                         
                                         
                                         
     Else
     !HistCaixa = !HistCaixa & vbCrLf & "*-*-*-*-*-*-*-*-*-*-*-*-* Dinheiro *-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-"
     !HistCaixa = !HistCaixa & vbCrLf & "DATA: " & Me.DataPagamento & vbCrLf & _
                                          "Mascote:  " & Me.Animal & vbCrLf & _
                                          "Desc.:  " & FormatCurrency(Me.Descontos) & " Total pago:  " & FormatCurrency(Me.Valor) & vbCrLf & strHist
                                       

     End If
    .Update

    End With


    '------------------------------------------------------------------------------------------------------------------------------------------
    Dim DB1 As Database
    Dim db2 As Database
    Dim rs1 As DAO.Recordset
    Dim rs2 As DAO.Recordset
    Dim db4 As Database
    Dim rs4 As DAO.Recordset
    '------------------------------------------------------------------------------------------------------------------------------------------
    'Nova rotina de exportação para a tabela ateencerado
    If Me.Dinheiro = -1 Then

       
            'fazendo do subformulário um recordset
            Set rs1 = Me!SFrmCaixa.Form.RecordsetClone
           
            'verificando se há registros no subformulário
            If rs1.RecordCount > 0 Then
           
                Call rs1.MoveFirst
                Set DB1 = CurrentDb
                Set rs2 = DB1.OpenRecordset("Ateencerrado", , Cool 'abrindo para somente adição
               
                With rs2
                Do 'iniciando loop

                    Call .AddNew
                   
                        ![idcaixa] = Me.idcaixa
                        ![proprietario] = Me.proprietario
                        ![Animal] = Me.Animal
                        ![DataPagamento] = Me.DataPagamento
                        ![Valor] = Me.ValorDinheiro
                        ![Dinheiro] = -1
                        ![Usuario] = [Forms]![login]![USER] & " / " & Now

                        'campos que estão no subformulário
                        ![TipoServico] = rs1!TipoServico
                        ![Servico] = rs1!Servico
                        ![Custo] = rs1!Custo
                        ![Qtd] = rs1!Qtd
                        ![NomeGrupo] = rs1!NomeGrupo
                       
                    Call .Update
                    Call rs1.MoveNext

                'condição para finalizar o loop
                Loop Until rs1.EOF
                End With
               
                Call rs2.Close: Set rs2 = Nothing
                Set DB1 = Nothing
               
            End If
           
            Set rs1 = Nothing
           
        End If
     

    '---------------------------------------------------------------------------------------------------------------------------------
    Set db2 = CurrentDb
    Set rs2 = db2.OpenRecordset("tblsaldo")
    With rs2
    .AddNew
    ![idcaixa] = Me.idcaixa
    ![Valorentrada] = Me.ValorDinheiro
    ![Data] = Me.DataPagamento
    ![Descricao] = "Pgto Caixa Dinheiro" & " Nº : " & Me.idcaixa & "    Cliente:  " & Me.proprietario
    .Update
    End With

    'realizo a exportação para a tblentradadia que mostra o quanto esta entrando em R$
    Set db4 = CurrentDb
    Set rs4 = db4.OpenRecordset("tblentradadia")
    With rs4
    .AddNew
    ![idcaixa] = Me.idcaixa
    ![DataEntrada] = Me.DataPagamento
    ![proprietario] = Me.proprietario & "  - " & " Dinheiro"
    ![EntrValor] = Me.ValorDinheiro
    .Update
    End With
    End If
    End If
    End If
    MsgBox "Entrada Caixa... salva com sucesso!", vbInformation, Me.Caption
    End Sub

    Se alguém puder me dar uma luz, fico agradecido desde já.

    Abraços a todos.


    .................................................................................
    Caso tenha resolvido a tua duvida, coloque o tópico como resolvido.
    www.maximoaccess.com/t860-resolucao-de-topicos

    "Quase tudo é possível quando se tem determinação e força de vontade. Não desista tão rápido."
    Silvio
    Silvio
    Developer
    Developer


    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 5028
    Registrado : 20/04/2011

    Registro duplicando sozinho no evento Onclick  ( apenas um clique de mouse ) !!! Empty Re: Registro duplicando sozinho no evento Onclick ( apenas um clique de mouse ) !!!

    Mensagem  Silvio 4/11/2022, 12:23

    UP


    .................................................................................
    Caso tenha resolvido a tua duvida, coloque o tópico como resolvido.
    www.maximoaccess.com/t860-resolucao-de-topicos

    "Quase tudo é possível quando se tem determinação e força de vontade. Não desista tão rápido."
    Silvio
    Silvio
    Developer
    Developer


    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 5028
    Registrado : 20/04/2011

    Registro duplicando sozinho no evento Onclick  ( apenas um clique de mouse ) !!! Empty Re: Registro duplicando sozinho no evento Onclick ( apenas um clique de mouse ) !!!

    Mensagem  Silvio 7/11/2022, 12:45

    up


    .................................................................................
    Caso tenha resolvido a tua duvida, coloque o tópico como resolvido.
    www.maximoaccess.com/t860-resolucao-de-topicos

    "Quase tudo é possível quando se tem determinação e força de vontade. Não desista tão rápido."
    Silvio
    Silvio
    Developer
    Developer


    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 5028
    Registrado : 20/04/2011

    Registro duplicando sozinho no evento Onclick  ( apenas um clique de mouse ) !!! Empty Re: Registro duplicando sozinho no evento Onclick ( apenas um clique de mouse ) !!!

    Mensagem  Silvio 7/11/2022, 14:14

    UP


    .................................................................................
    Caso tenha resolvido a tua duvida, coloque o tópico como resolvido.
    www.maximoaccess.com/t860-resolucao-de-topicos

    "Quase tudo é possível quando se tem determinação e força de vontade. Não desista tão rápido."
    Alexandre Fim
    Alexandre Fim
    Developer
    Developer


    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 2772
    Registrado : 13/12/2016

    Registro duplicando sozinho no evento Onclick  ( apenas um clique de mouse ) !!! Empty Re: Registro duplicando sozinho no evento Onclick ( apenas um clique de mouse ) !!!

    Mensagem  Alexandre Fim 7/11/2022, 15:26

    Silvio,

    Consegue mandar somente os objetos envolvidos nesta questão, para análise e solução do problema?
    Previamente, fiz uma análise no código que vc mandou, e está muito confuso.

    No código existe 2 declarações de "On Error Resume Next", desnecessárias. Somente 1 já basta.
    A propósito, não se deve colocar esta instrução pois ela "ignora" qualquer erro que ocorra no procedimento. O correto é fazer o tratamento de erro.

    Declarações abaixo:
    Dim DB1 As Database => instanciado para o CurrentDb
    Dim db2 As Database => instanciado para o CurrentDb
    Dim db4 As Database => instanciado para o CurrentDb
    Dim db7 As Database => instanciado para o CurrentDb

    Varias instâncias declaradas para o mesmo database. Desnecessário também!

    Dentro do código que vc mandou existe vários processos rodando dentro dele.
    Sempre que possível, separar esses processos em Sub's pertinentes ao processo desejado.

    Ex.:
    'Rotina para exportar historicos
    Private Sub ExportHistCaixa()

    'Nova rotina de exportação para a tabela ateencerado
    Private Sub ExportAteEncerado()

    'realizo a exportação para a tblentradadia que mostra o quanto esta entrando em R$
    Private Sub ExportEntradaDia()

    No aguardo do encvio do bd para análise.

    é isso

    Att,

    Alexandre Fim


    .................................................................................
    Arrow  Marcar tópico como Resolvido: clique aqui
    Arrow  Postar anexos no fórum: clique aqui

    Registro duplicando sozinho no evento Onclick  ( apenas um clique de mouse ) !!! Setinf11
    Sistemas e Tecnologia Ltda
    Silvio
    Silvio
    Developer
    Developer


    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 5028
    Registrado : 20/04/2011

    Registro duplicando sozinho no evento Onclick  ( apenas um clique de mouse ) !!! Empty Re: Registro duplicando sozinho no evento Onclick ( apenas um clique de mouse ) !!!

    Mensagem  Silvio 8/11/2022, 10:57

    Bom dia / boa tarde / boa noite.

    Alexandre, o segundo " on error..." já tinha suprido ele antes de mandar aqui.

    Agora, a ideia foi boa de fazer uma chamada para um Private sub, não havia pensado nisso ainda.

    O sistema cresceu vertiginosamente de um ano para cá, fica quase impossível de mandar.



    .................................................................................
    Caso tenha resolvido a tua duvida, coloque o tópico como resolvido.
    www.maximoaccess.com/t860-resolucao-de-topicos

    "Quase tudo é possível quando se tem determinação e força de vontade. Não desista tão rápido."

      Data/hora atual: 7/2/2023, 23:53