[Resolvido]Ajuda em rotina de registos automáticos

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

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

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

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.

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

Obrigado JPaulo

Bom

Fico feliz.

Boas festas.