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]Ajuda em rotina de registos automáticos

    Compartilhe
    Assis
    Assis
    Maximo VIP
    Maximo VIP

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Portugal
    Mensagens : 3661
    Registrado : 06/11/2009

    [Resolvido]Ajuda em rotina de registos automáticos

    Mensagem  Assis em 17/12/2018, 12:21

    Bom dia Amigos

    Esta rotina regista movimentos desde janeiro a Dezembro do Ano corrente, se não detetar na tabela registos nesses meses.

    Quando chamada vai informando Mês a mês o registo efetuado.

    Queria registar mês a mês do género:

    Depois de registar por exemplo Janeiro perguntava se queria continuar, caso a resposta for "Sim" continuava para o Mês seguinte. Caso Não parava .


    Obrigado  

    '-----------------------------------------------------------------------
    Sub MovimentosAutomaticos()
    'codigo Alterado por Cláudio Más
    Dim D As Byte, DataComparacao As Date, M As Byte

    For M = 1 To Month(Date)
       Forms!Movimentos.Tag = Format$(M, "00") & Format(Now, "-yyyy")
       If DCount("*", "qry_MovimentosAutomaticos") = 0 Then
       'ainda n?o h? registos do m?s/ano
     
       For D = 1 To 10

                DataComparacao = DateSerial(Year(Now), M, D)
                                                                                                                                                       
             If Weekday(DataComparacao) <> 1 And Weekday(DataComparacao) <> 7 And Feriado(DataComparacao) = False Then
                CurrentDb.Execute "INSERT INTO MovimentosAutomaticos SELECT Format(DateSerial(Year(Now), " & M & ", " & D & "), 'dd-mm-yyyy') as DataM, Entidade, ValorEntrada FROM Entidades Where Entidades.[Marca] = True"
                MsgBox "" & Format(DataComparacao, "mmmm - yyyy") & " Registado ", vbInformation, "     Administrador do Sistema !"

                If Month(DataComparacao) = 3 Or Month(DataComparacao) = 9 Then
               If DCount("*", "Seguros", "[Marca] = True") > 0 Then
                   CurrentDb.Execute "INSERT INTO MovimentosAutomaticos SELECT Format(DateSerial(Year(Now), " & M & ", " & D & "), 'dd-mm-yyyy') as DataM, Entidade, ValorEntrada FROM Seguros Where Seguros.[Marca] = True"
                   MsgBox "Seguro de " & Format(DataComparacao, "mmmm - yyyy") & " Registado ", vbInformation, "     Administrador do Sistema !"
               End If
           End If

                 
                   Exit For
             
                 End If

            Next

       End If

    Next M

    MsgBoxTimer 1, "Tudo Registado Até " & Format(Date, "mmmm - yyyy") & "  ", vbInformation, "Administrador do Sistema!"
           

    Exit Sub
    End Sub


    .................................................................................
    *** Só sei que nada sei ***
    Assis
    Assis
    Maximo VIP
    Maximo VIP

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Portugal
    Mensagens : 3661
    Registrado : 06/11/2009

    Re: [Resolvido]Ajuda em rotina de registos automáticos

    Mensagem  Assis em 18/12/2018, 14:01

    Boa tarde Amigos

    Consegui desmembrar o necessário.


    Abre o Formulário "Menu"

    Clikar em Registar.

    Diz que tem meses em atraso

    Clikar Sim.


    Depois de informar que registou o Mês x , pergunta se quer continuar.

    Se clicar "Não" terá que parar a rotina ….. mas não para vai atá a data atual


    .................................................................................
    *** Só sei que nada sei ***
    JPaulo
    JPaulo
    Moderador
    Moderador

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Portugal
    Mensagens : 10360
    Registrado : 04/11/2009

    Re: [Resolvido]Ajuda em rotina de registos automáticos

    Mensagem  JPaulo em 18/12/2018, 14:32

    Se você quer mesmo parar a rotina, o SUB não pode estar dentro de um modulo;

    Terá de ser assim;

    Código:
    Private Sub Comando10_Click()
    'Call MovimentosAutomaticos
    'código Alterado por Cláudio Más
    Dim D As Byte, DataComparacao As Date, M As Byte

    For M = 1 To Month(Date)
        Forms!movimentos.Tag = Format$(M, "00") & Format(Now, "-yyyy")
        If DCount("*", "qry_MovimentosAutomaticos") = 0 Then
        'ainda não há registos do mês/ano
       
       
        If MsgBox("Continuar Para o Mês Seguinte ? ", vbYesNo + vbQuestion, "Administrador ") = vbYes Then
     
        For D = 1 To 10

                DataComparacao = DateSerial(Year(Now), M, D)
                                                                                                                                                       
              If Weekday(DataComparacao) <> 1 And Weekday(DataComparacao) <> 7 And Feriado(DataComparacao) = False Then
                CurrentDb.Execute "INSERT INTO MovimentosAutomaticos SELECT Format(DateSerial(Year(Now), " & M & ", " & D & "), 'dd-mm-yyyy') as DataM, Entidade, ValorEntrada FROM Entidades Where Entidades.[Marca] = True"
                MsgBox "Condomínio de " & Format(DataComparacao, "mmmm - yyyy") & " Registado ", vbInformation, "    Administrador do Sistema !"

                If Month(DataComparacao) = 3 Or Month(DataComparacao) = 9 Then
                If DCount("*", "Seguros", "[Marca] = True") > 0 Then
                    CurrentDb.Execute "INSERT INTO MovimentosAutomaticos SELECT Format(DateSerial(Year(Now), " & M & ", " & D & "), 'dd-mm-yyyy') as DataM, Entidade, ValorEntrada FROM Seguros Where Seguros.[Marca] = True"
                    MsgBox "Seguro de " & Format(DataComparacao, "mmmm - yyyy") & " Registado ", vbInformation, "    Administrador do Sistema !"
                End If
            End If

                    Exit For
             
                  End If

            Next

          End If
          Exit Sub
        Else

    DoCmd.CancelEvent

    End If
    Next M


    1: MsgBoxTimer 1, "Tudo Registado Até " & Format(DLookup("[datam]", "movimentosautomaticoscc"), "mmmm - yyyy") & "  ", vbInformation, "Administrador do Sistema!"


    Exit Sub
    Me.Requery
    Call Form_Load
    End Sub


    .................................................................................
    Contribua com o maximoaccess nos links abaixo, ajude a melhorar este que é o seu site na NET.

    Pay-Pal R$ Aqui
    Pay-Pal € Aqui

    Ou ainda: Aqui (Novo)

    Sucesso e Bons Estudos
    Success and Good Studies

    Utilize o Sistema de Busca do Fórum...
    102 Códigos VBA Gratuitos...
    Instruções SQL como utilizar...
    Assis
    Assis
    Maximo VIP
    Maximo VIP

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Portugal
    Mensagens : 3661
    Registrado : 06/11/2009

    Re: [Resolvido]Ajuda em rotina de registos automáticos

    Mensagem  Assis em 18/12/2018, 15:59

    JPaulo

    Assim só regista mês a mês.

    Veja o exemplo que alterei.

    A sub já não está num Módulo, está no formulário "Movimentos".

    O Botão registar abre o formulário "Movimentos", e este ao ser aberto tem um botão oculto, que aciona a sub.
    Anexos
    Exemplo Assis2.zip
    Você não tem permissão para fazer download dos arquivos anexados.
    (455 Kb) Baixado 4 vez(es)


    .................................................................................
    *** Só sei que nada sei ***
    JPaulo
    JPaulo
    Moderador
    Moderador

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Portugal
    Mensagens : 10360
    Registrado : 04/11/2009

    Re: [Resolvido]Ajuda em rotina de registos automáticos

    Mensagem  JPaulo em 18/12/2018, 16:20

    O sub estava num modulo sim, no primeiro exemplo.

    Você tem de correr todo o trecho de código nesse mesmo botão e não em separado;

    Download

    Código:
    Private Sub Comando10_Click()
    'Call MovimentosAutomaticos
    'código Alterado por Cláudio Más
    Dim D As Byte, DataComparacao As Date, M As Byte

    For M = 1 To Month(Date)
        Forms!movimentos.Tag = Format$(M, "00") & Format(Now, "-yyyy")
        If DCount("*", "qry_MovimentosAutomaticos") = 0 Then
        'ainda não há registos do mês/ano
        
        
        If MsgBox("Continuar Para o Mês Seguinte ? ", vbYesNo + vbQuestion, "Administrador ") = vbNo Then Me.Requery: Exit Sub
      
        For D = 1 To 10

                 DataComparacao = DateSerial(Year(Now), M, D)
                                                                                                                                                        
              If Weekday(DataComparacao) <> 1 And Weekday(DataComparacao) <> 7 And Feriado(DataComparacao) = False Then
                 CurrentDb.Execute "INSERT INTO MovimentosAutomaticos SELECT Format(DateSerial(Year(Now), " & M & ", " & D & "), 'dd-mm-yyyy') as DataM, Entidade, ValorEntrada FROM Entidades Where Entidades.[Marca] = True"
                 MsgBox "Condomínio de " & Format(DataComparacao, "mmmm - yyyy") & " Registado ", vbInformation, "     Administrador do Sistema !"

                 If Month(DataComparacao) = 3 Or Month(DataComparacao) = 9 Then
                If DCount("*", "Seguros", "[Marca] = True") > 0 Then
                    CurrentDb.Execute "INSERT INTO MovimentosAutomaticos SELECT Format(DateSerial(Year(Now), " & M & ", " & D & "), 'dd-mm-yyyy') as DataM, Entidade, ValorEntrada FROM Seguros Where Seguros.[Marca] = True"
                    MsgBox "Seguro de " & Format(DataComparacao, "mmmm - yyyy") & " Registado ", vbInformation, "     Administrador do Sistema !"
                End If
            End If

                    Exit For
              
                  End If

             Next

          End If
    Next M


    1: MsgBoxTimer 1, "Tudo Registado Até " & Format(DLookup("[datam]", "movimentosautomaticoscc"), "mmmm - yyyy") & "  ", vbInformation, "Administrador do Sistema!"


    Exit Sub
    Me.Requery
    Call Form_Load
    End Sub


    .................................................................................
    Contribua com o maximoaccess nos links abaixo, ajude a melhorar este que é o seu site na NET.

    Pay-Pal R$ Aqui
    Pay-Pal € Aqui

    Ou ainda: Aqui (Novo)

    Sucesso e Bons Estudos
    Success and Good Studies

    Utilize o Sistema de Busca do Fórum...
    102 Códigos VBA Gratuitos...
    Instruções SQL como utilizar...
    Assis
    Assis
    Maximo VIP
    Maximo VIP

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Portugal
    Mensagens : 3661
    Registrado : 06/11/2009

    Re: [Resolvido]Ajuda em rotina de registos automáticos

    Mensagem  Assis em 18/12/2018, 16:49

    Obrigado JPaulo

    Bom santa


    .................................................................................
    *** Só sei que nada sei ***
    JPaulo
    JPaulo
    Moderador
    Moderador

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Portugal
    Mensagens : 10360
    Registrado : 04/11/2009

    Re: [Resolvido]Ajuda em rotina de registos automáticos

    Mensagem  JPaulo em 18/12/2018, 17:12

    Fico feliz.

    Boas festas.


    .................................................................................
    Contribua com o maximoaccess nos links abaixo, ajude a melhorar este que é o seu site na NET.

    Pay-Pal R$ Aqui
    Pay-Pal € Aqui

    Ou ainda: Aqui (Novo)

    Sucesso e Bons Estudos
    Success and Good Studies

    Utilize o Sistema de Busca do Fórum...
    102 Códigos VBA Gratuitos...
    Instruções SQL como utilizar...

      Data/hora atual: 23/1/2019, 08:10