[Resolvido]Alteração código (Autor Alexandre Neves)

Boa tarde

Este código gera movimentos automáticos numa tabela chamada "MovimentosAutomaticos", com dados gravados noutra tabela ao Clikar num botão de comando.

Exemplo
Janeiro 2013
Ao clikar num botão , se não tiver registos em janeiro os registos são efectuados.

Mas se a BD em fevereiro nada for registado por exemplo.

Ao abrir a BD em março ele regista os registos de março e não regista os movimentos de fevereiro.

Seria possivel por exemplo se abrir a BD em Junho, e não tiver registos de fevereio, março, abril, maio, ao clikar

no respectivo botão que chama a função gravar os meses que não tem registos e o mês de junho ?



-----------------------------------
'código criado por Alexandre Neves
'do fórum MaximoAccess

Sub MovimentosAutomaticos()
' Feriados e Sabados e Domingos
Dim D As Byte, DataComparacao As Date
If DCount("*", "MovimentosAutomaticos", "Format(DataM,'mm-yyyy')=Format(Now,'mm-yyyy')") = 0 Then
'ainda não há registos do mês/ano
For D = 1 To 10
DataComparacao = DateSerial(Year(Date), Month(Date), D)
If Weekday(DataComparacao) <> 1 And Weekday(DataComparacao) <> 7 And Feriado(DataComparacao) = False Then
CurrentDb.Execute "INSERT INTO MovimentosAutomaticos SELECT Format(DateSerial(Year(Now), Month(Now)," & D & "), 'dd-mm-yyyy') as DataM, Entidade, ValorEntrada FROM Entidades;"
Exit For
End If
Next
End If
End Sub

Se não for exatamente isso, tente adaptar, a idéia é essa:

Código:

Dim D As Byte, DataComparacao As Date, m As Byte, strCriterio As String

For m = "01" To Format$(Date(), "mm")
    strCriterio = m & Format(DataM,"-yyyy") & " = " & m & Format(Now,"-yyyy")
    If DCount("*", "MovimentosAutomaticos", strCriterio) = 0 Then
    'ainda não há registos do mês/ano
    For D = 1 To 10
        DataComparacao = DateSerial(Year(Date), Month(Date), D)
        If Weekday(DataComparacao) <> 1 And Weekday(DataComparacao) <> 7 And Feriado(DataComparacao) = False Then
            CurrentDb.Execute "INSERT INTO MovimentosAutomaticos SELECT Format(DateSerial(Year(Now), Month(Now)," & D & "), 'dd-mm-yyyy') as DataM, Entidade, ValorEntrada FROM Entidades;"
            Exit For
        End If
    Next
    End If
Next m

End Sub

Boa tarde
Cláudio

Ao executar seleciona o que esta a vermelho

Dim D As Byte, DataComparacao As Date, m As Byte, strCriterio As String

For m = "01" To Format$(Date, "mm")
strCriterio = m & Format(DataM, "-yyyy") & " = " & m & Format(Now, "-yyyy")
If DCount("*", "MovimentosAutomaticos", strCriterio) = 0 Then
'ainda não há registos do mês/ano
For D = 1 To 10
DataComparacao = DateSerial(Year(Date), Month(Date), D)
If Weekday(DataComparacao) <> 1 And Weekday(DataComparacao) <> 7 And Feriado(DataComparacao) = False Then
CurrentDb.Execute "INSERT INTO MovimentosAutomaticos SELECT Format(DateSerial(Year(Now), Month(Now)," & D & "), 'dd-mm-yyyy') as DataM, Entidade, ValorEntrada FROM Entidades;"
Exit For
End If
Next
End If

Cláudio

Digitei

Dim DataM as Date

Fez os movimentos anteriores.
Mas a dataM é que devia ser sempre a corresponder com o mês em falta
Pois os meses em falta são registados com o primeiro dia do mês do sistema.
Quer que poste aqui a BD para testar?
Obrigado

Sim, mas antes tente isso:

strCriterio = m & "Format(DataM,'-yyyy') = " & m & Format(Now, "-yyyy")

Cláudio

Com a 2º dica da erro

Segue anexo

Obrigado

Acho até que dava pra resolver no critério do Dcount(), mas ficou mais fácil com algo que costumam chamar de "gambiarra"...

Cláudio

Se neste ano 2013 não tiver nenhum registo na tabela, e abrir a BD com data do sistema em 01-02-2013 " fevereiro " ao executar o comando devia ficar com:

4 Registos: 2 de janeiro + 2 de fevereiro.

1 registos com data de 02-01-2013 Arrumo FCR 0,36 €
1 registos com data de 02-01-2013 Arrumo Quota FCR 3,64 €

1 registos com data de 01-02-2013 Arrumo FCR 0,36 €
1 registos com data de 01-02-2013 Arrumo Quota FCR 3,64 €

Sim, e não é isso que está ocorrendo?

Cláudio

Alterei a data do PC e regista tudo com data de 01-02-2013

Testou ?

Sim, testei sem alterar a data do PC.

Foram criados 4 registros, certo?
Então o problema inicial foi resolvido, o Insert é executado para todos os meses, de janeiro até o atual.

Agora o problema é outro, você precisa corrigir a sua instrução SQL (Insert) para gerar os registros com a DataM correta.

Para ajudar com essa instrução, eu teria que conhecer as regras: por que o loop de 1 a 10; por que os registros de janeiro devem ser com o dia 2, e fevereiro com o dia 1.

Cláudio

janeiro devem ser com o dia 2, e fevereiro com o dia 1, porque :

Não marca nos feriados nem sabados e domingos, e aqui em PT o 1 de jan é feriado.

DataComparacao = DateSerial(Year(Date), m, D)

CurrentDb.Execute "INSERT INTO MovimentosAutomaticos SELECT Format(DateSerial(Year(Now), " & m & ", " & D & "), 'dd-mm-yyyy') as DataM, Entidade, ValorEntrada FROM Entidades;"

Obrigado Cláudio

De nada.