Question sur la fonction "Application.OnTime"

Bonjour à tous,

Contexte,

Tout les matins j'ouvre un fichier Excel.

Problème

Je souhaite qu'à son ouverture Excel lance à une heure donnée une macro de mise à jour de date.

Pour cela je commence par introduire une Private sub:

Private Sub Worbook_Open()
     Application.OnTime TimeValue("09:00:00"), "Date_New", , True
End Sub

Ma macro est la suivante:

Sub Date_New()
    If Weekday(Now(), vbMonday) < 6 Then
        Beep
        If MsgBox("Souhaitez-vous ajoutez la date du jour:" & Chr(10) & _
            "'' " & Format(Now(), "dddd dd/mm/yyyy") & " ''" & " à l'historique des dates ?", _
            vbYesNo + vbQuestion + vbDefaultButton1 + vbSystemModal, "Ajout date du jour") = vbYes Then
            Windows("test1.xlsm").Activate
            Sheets("Feuil1").Select
            Range("c55").Select
            Selection.ClearContents
            Range("c55") = Application.WorksheetFunction.RoundDown(Now(), 0)
        End If
    End If
    Application.OnTime TimeValue("09:00:00"), "Date_New", , True
End Sub

A la fin de la macro je lance la fonction "Application.OnTime" afin de relancer la macro pour le lendemain, au cas ou mon fichier resterait ouvert.

Enfin lorsque je ferme mon fichier j’introduis une seconde Private Sub afin d'arretter le timer:

Private Sub Workbook_beforeclose (Cancel As Boolean)
     Application.OnTime TimeValue("09:00:00"), "Date_New", , False
End Sub

Question

Je suis tout à fait novice en VBA, et je souhaiterai savoir si les pro du VBA qui soutiennent courageusement ce forum pourraient me donner leur avis sur ma façon de procéder.

D'avance merci pour vos contributions.

Cordialement

Bonjour

pdm a écrit :

Je suis tout à fait novice en VBA

Pas tant que ça

Pour moi ton raisonnement est bon

Juste une modification dans la macro Date_New

  • Comme tu es dans le bon classeur : "test1.xlsm" --> Pas besoin de l'activer
  • Pas besoin de sélectionner la page
  • Pas besoin d'effacer la cellule, car ce que tu vas écrire remplace l'ancienne valeur

Dans ta question tu parles " l'historique des dates" mais tu écris toujours au même endroit

Sub Date_New()
  If Weekday(Now(), vbMonday) < 6 Then
    Beep
    If MsgBox("Souhaitez-vous ajoutez la date du jour:" & Chr(10) & _
          "'' " & Format(Now(), "dddd dd/mm/yyyy") & " ''" & " à l'historique des dates ?", _
          vbYesNo + vbQuestion + vbDefaultButton1 + vbSystemModal, "Ajout date du jour") = vbYes Then
      Sheets("Feuil1").Range("C55") = Application.WorksheetFunction.RoundDown(Now(), 0)
    End If
  End If
  Application.OnTime TimeValue("09:00:00"), "Date_New", , True
End Sub

Bonjour Banzai64,

Merci pour tes conseils j'en prend note.

J'ai cependant un problème:

Lorsque j"ouvre mon fichier après 9h00 il ne me propose pas de mettre à jour la date pourquoi?

Cordialement

Bonjour

pdm a écrit :

Lorsque j"ouvre mon fichier après 9h00 il ne me propose pas de mettre à jour la date pourquoi?

Sans doute parce qu'il attend qu'il soit 9h00

Testes l'heure quand tu ouvres ton fichier

Si pas 9h00 lances le décompte

Si après 9h00 exécutes la macro, qui elle lancera le décompte

Style

Private Sub Worbook_Open()
  If Time < "09:00" Then
    Application.OnTime TimeValue("09:00:00"), "Date_New", , True
  Else
   Date_New
  End If
End Sub

Merci Banzai64

Une nouvelle fois tes conseils m'ont été très utile .

A bientôt

Cordialement

Rechercher des sujets similaires à "question fonction application ontime"