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

    [Resolvido]Ajuda em rotina de registos automáticos

    Assis
    Assis
    Maximo VIP
    Maximo VIP

    Respeito às regras : Respeito às Regras 100%

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

    [Resolvido]Ajuda em rotina de registos automáticos Empty [Resolvido]Ajuda em rotina de registos automáticos

    Mensagem  Assis 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 : Respeito às Regras 100%

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

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

    Mensagem  Assis 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 : Respeito às Regras 100%

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

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

    Mensagem  JPaulo 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

    [Resolvido]Ajuda em rotina de registos automáticos Folder_announce_new Utilize o Sistema de Busca do Fórum...
    [Resolvido]Ajuda em rotina de registos automáticos Folder_announce_new 102 Códigos VBA Gratuitos...
    [Resolvido]Ajuda em rotina de registos automáticos Folder_announce_new Instruções SQL como utilizar...
    Assis
    Assis
    Maximo VIP
    Maximo VIP

    Respeito às regras : Respeito às Regras 100%

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

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

    Mensagem  Assis 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
    [Resolvido]Ajuda em rotina de registos automáticos AttachmentExemplo Assis2.zip
    Você não tem permissão para fazer download dos arquivos anexados.
    (455 Kb) Baixado 9 vez(es)


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

    Respeito às regras : Respeito às Regras 100%

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

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

    Mensagem  JPaulo 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

    [Resolvido]Ajuda em rotina de registos automáticos Folder_announce_new Utilize o Sistema de Busca do Fórum...
    [Resolvido]Ajuda em rotina de registos automáticos Folder_announce_new 102 Códigos VBA Gratuitos...
    [Resolvido]Ajuda em rotina de registos automáticos Folder_announce_new Instruções SQL como utilizar...
    Assis
    Assis
    Maximo VIP
    Maximo VIP

    Respeito às regras : Respeito às Regras 100%

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

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

    Mensagem  Assis 18/12/2018, 16:49

    Obrigado JPaulo

    Bom santa


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

    Respeito às regras : Respeito às Regras 100%

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

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

    Mensagem  JPaulo 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

    [Resolvido]Ajuda em rotina de registos automáticos Folder_announce_new Utilize o Sistema de Busca do Fórum...
    [Resolvido]Ajuda em rotina de registos automáticos Folder_announce_new 102 Códigos VBA Gratuitos...
    [Resolvido]Ajuda em rotina de registos automáticos Folder_announce_new Instruções SQL como utilizar...

      Data/hora atual: 25/7/2021, 03:52