Exécution d'une macro chaque jour

Bonsoir,
Mon problème concerne l'exécution d'une macro chaque jour (à 8h du matin par exemple) sachant que l'application qui la contient est ouverte 24H/24
J'ai essayé d'inséré le code suivant dans un module:

Sub auto_open()
heure = "22:41:00"
Application.OnTime EarliestTime:=TimeValue(heure), Procedure:="ferme"
End Sub

Sub ferme()
MsgBox ("bonsoir")
End Sub

Mais ca marche seulement une fois, c'est la 1ère fois après l'ouverture du classeur, donc je dois réouvrir le classeur chaque jour pour activer la macro, or j'ai voulu automatisé la tache.

Merci pour vos réponses

7 réponses

  1. re:

    Encore plus simple :

    Option Explicit
    '
    
    Sub TestTemps()
        
        Application.OnTime TimeValue("14:05:00"), "ExecuteCommande", , True
    
    End Sub
    '
    
    Sub StopTestTemps()
    
        Application.OnTime TimeValue("14:05:00"), "ExecuteCommande", False
        
        MsgBox "Fin"
    
    End Sub
    '
    
    Private Sub ExecuteCommande()
    
        MsgBox "Lupin exécute commande"
    
    End Sub
    '
    


    Cdt

    Lupin
    0
    1. re,
      Je pense que tu n'a pas saisi mon problème; en effet le code qui se lance à une heure programmée (à 19:47:00 par exemple) c'est faisable, et ca marche pour moi avec ton code, maintenant si je fais modifier l'heure et le jour de mon PC(je modifie la date du jour de pc 18juin par exemple) pour voir si le code va s'exécuter (en laissant l'application ouverte) je n'obtiens rien.
      Moralité, je crois que j'ai besoin d'un procédure qui s'exécute chaque jour
      Merci pour tout Lupin
      0
  2. re:

    Voici, le code fonctionnel et testé sous Excel 2003 :-)

    Option Explicit
    '
    
    Sub TestTemps()
    
        Dim Heure As Date
        
        Heure = Now
    
        If (Format(TimeValue(Heure), "hh:mm:ss") > "12:49:00") And _
            (Format(TimeValue(Heure), "hh:mm:ss") < "12:51:00") Then
            ExecuteCommande
        End If
        
        Application.OnTime TimeValue("12:50:00"), "TestTemps", , True
    
    End Sub
    '
    
    Sub StopTestTemps()
    
        Application.OnTime TimeValue("13:00:00"), "TestTemps", False
        
        MsgBox "Fin"
    
    End Sub
    '
    
    Private Sub ExecuteCommande()
    
        MsgBox "Lupin exécute commande"
    
    End Sub
    '
    


    Cdt

    Lupin
    0
    1. Bonjour,

      Bon, je comprends ta remarque jijilamara, mais tu oublies
      quelque chose, même le robot le plus sophistiqué aura
      besoin d'un premier démarrage.

      Tout système informatique nécessite un premier démarrage.

      Maintenant, il y a plusieurs façon de lancer la boucle.

      Examinons ensemble mon premier jet de code.

      On y retrouve 2 routines :

      la première étant la routine de boucle, qui se rappelle
      continuellement à toute les heures par l'instruction :

      Application.OnTime EarliestTime + 3600, TestTemps

      n.b. j'y ai oublié les guillemets pour le nom de la procédure :

      Application.OnTime EarliestTime + 3600, "TestTemps"

      donc le nom de la routine est "TestTemps", et elle se rapelle
      d'elle même toute les heures.

      N'est ce pas ce que tu voulais ?

      Cette même routine fait un test sur l'heure actuel (au moment
      ou elle est appellé), s'il est 8h00 am, elle exécute une nouvelle
      routine qui se nomme "ExecuteCommande", une routine quelconque
      montré ici en exemple.

      Donc, une fois la boucle lancée, elle s'exécutera d'elle même
      indéfiniement, ton OS tomberas avant que celle-ci ne s'arrête !

      Pour ce qui est du premier démarrage, si tu ne veux le faire
      manuellement, tu place un appel dans le module ThisWorkbook,
      dans la routine Workbook_Open().

      Option Explicit
      
      Private Sub Workbook_Open()
          Call TestTemps
      End Sub
      '
      


      Et tu utilise le planificateur de tâche de windows pour ouvrir
      le classeur une première fois.

      Si j'ai bien compris ton besoin, c'est tout à fait ce que tu
      recherche ? N'ai-je pas raison ?

      Cdt

      Lupin
      0
      1. Bonjour Lupin,
        Il me répond EarliestTime variable non définis, et lorsque je supprime Option explicit il se plante,
        Sinon pour ta réponse, ce que je veux c'est une 1ere et une seule ouverture (après la programmation du code) sera suffisante pour vérifier chaque jour l'heure (sans avoir à la réouvrir chaque jour) or avec pas mal de tentatives de codes il ne prend en considération la vérification de l'heure que après une autre ouverture= il me faut le réouvrir chaque jour, et comme j'ai déja dis l'application est ouverte 24h/24
        Merci Lupin
        0
    2. Contributeur
      Bonjour,

      Dans la procédure qui est appelée ('ferme' dans ton exemple) il faut que tu ré-exécute Application.OnTime pour initialiser le prochain lancement.

      Il faudra peut-être ajouter une petite tempo avant le temps que la seconde en cours soit écoulée, et pas que la procédure se relance aussitôt...

      eric
      0
      1. Merci Lupin pour tes réponses, apparemment pour le 1er code que tu a posté ca pose le meme problème, il fallait un truc(bouton, ou evenement open )pour exécuter la tache, alors que l'application est ouverte 24H/24, je dois automatiser la tache, sans avoir a réouvrir l'application :la macro doit s'éxécuer à une heure fixe.en fait j'ai fait des essais en modifiant l'heure de mon pc pour savoir est ce que ça va se répéter chaque jour.
        Le 2ème problème je l'ai pas compris.
        Merci de m'aider dans la recherche de solution
        0
        1. re:

          Voici un exemple plus complexe, issue de la toile:

          De Chip Pearson :

          'Attribute VB_Name = "Horloge"
          Option Explicit
          
          'Créer une horloge (très stylisée mais fonctionnelle:-))
          'dans une feuille de calcul   Chip Pearson, mpep
          
          '''
          ' Changer ces valeurs en fonction de votre système
          '''
          Const cCenterX As Single = 250
          Const cCenterY As Single = 250
          Const cLenSecond As Single = 150
          Const cLenMinute As Single = 125
          Const cLenHour As Single = 75
          '''
          
          Const PI As Single = 3.14159265358979
          Const TwoPI As Single = 2 * PI
          Dim RunWhen As Double
          
          Dim LS As Shape, LM As Shape, LH As Shape
          Dim LLS As LineFormat, LLM As LineFormat, LLH As LineFormat
          '
          
          Public Sub RunClock()
          
              If RunWhen = 0 Then
                  Init
              End If
              SetSecondHand Second(Now)
              SetMinuteHand Minute(Now) + (Second(Now) / 60) 'SetMinuteHand Minute(Now)
              SetHourHand Hour(Now) + (Minute(Now) / 60) 'SetHourHand Hour(Now)
              RunWhen = Now + TimeSerial(0, 0, 1)
              Application.OnTime RunWhen, "RunClock", , True
              
          End Sub
          '
          
          Public Sub StopClock()
          
              Dim WS As Worksheet
              Set WS = ActiveSheet
              
              On Error Resume Next
              Application.OnTime RunWhen, "RunClock", , False
              RunWhen = 0
              WS.Shapes("LineSecond").Delete
              WS.Shapes("LineMinute").Delete
              WS.Shapes("LineHour").Delete
              
          End Sub
          '
          
          Private Sub Init()
          
              Dim WS As Worksheet
              
              On Error Resume Next
              Set WS = ActiveSheet
              WS.Shapes("LineSecond").Delete
              WS.Shapes("LineMinute").Delete
              WS.Shapes("LineHour").Delete
              
              On Error GoTo 0
              ' create second hand
              Set LS = WS.Shapes.AddLine(beginx:=cCenterX, beginy:=cCenterY, _
                                  endx:=cCenterX, endy:=cCenterY - cLenSecond)
              Set LLS = LS.Line
              LS.Name = "LineSecond"
              LLS.EndArrowheadStyle = msoArrowheadOpen
              LLS.ForeColor.RGB = RGB(255, 0, 0)
              LLS.Weight = 1
              
              ' create minute hand
              Set LM = WS.Shapes.AddLine(beginx:=cCenterX, beginy:=cCenterY, _
                                  endx:=cCenterX, endy:=cCenterY - cLenMinute)
              Set LLM = LM.Line
              LM.Name = "LineMinute"
              LLM.EndArrowheadStyle = msoArrowheadTriangle
              LLM.ForeColor.RGB = RGB(0, 0, 255)
              LLM.Weight = 1.5
              
              ' create hour hand
              Set LH = WS.Shapes.AddLine(beginx:=cCenterX, beginy:=cCenterY, _
                                  endx:=cCenterX, endy:=cCenterY - cLenHour)
              Set LLH = LH.Line
              LH.Name = "LineHour"
              LLH.EndArrowheadStyle = msoArrowheadTriangle
              LLH.ForeColor.RGB = RGB(0, 0, 0)
              LLH.Weight = 1.75
              
          End Sub
          '
          
          Private Sub SetSecondHand(Seconds As Single)
          
              Dim Theta As Single ' clockwise angle from vertical
              Dim NewX As Single, NewY As Single
              
              Theta = (Seconds / 60) * TwoPI
              NewX = cCenterX + (cLenSecond * Sin(Theta))
              NewY = cCenterY - (cLenSecond * Cos(Theta))
              LS.Nodes.SetPosition 2, NewX, NewY
              
          End Sub
          '
          
          Sub SetMinuteHand(Minutes As Single)
          
              Dim Theta As Single ' clockwise angle from vertical
              Dim NewX As Single, NewY As Single
              
              Theta = (Minutes / 60) * TwoPI
              NewX = cCenterX + (cLenMinute * Sin(Theta))
              NewY = cCenterY - (cLenMinute * Cos(Theta))
              LM.Nodes.SetPosition 2, NewX, NewY
              
          End Sub
          '
          
          Private Sub SetHourHand(Hour As Single)
          
              Dim Theta As Single ' clockwise angle from vertical
              Dim NewX As Single, NewY As Single
            
              Theta = (Hour / 12) * TwoPI
              NewX = cCenterX + (cLenHour * Sin(Theta))
              NewY = cCenterY - (cLenHour * Cos(Theta))
              LH.Nodes.SetPosition 2, NewX, NewY
              
          End Sub
          '
          


          Cdt

          Lupin
          0
          1. Bonjour,

            Exemple type, pas testé :

            Une première procédure qui se rappelle toutes les heures, et qui
            appelle une autre procédure si le temps est à 8 heures.

            Note : La procédure TestTemps doit être lancé à une heure fixe,
            de zéro minute, zéro seconde.

            Option Explicit 
            ' 
            
            Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long) 
            ' 
            
            Sub TestTemps() 
            
                Dim Heure As Date 
                 
                Heure = Now 
            
                If (Format(TimeValue(Heure), "hh:mm:ss") > "07:59:00") And _ 
                    (Format(TimeValue(Heure), "hh:mm:ss") < "08:01:00") Then 
                    ExecuteCommande 
                End If 
                 
            
                Application.OnTime EarliestTime + 3600, TestTemps 
            
            End Sub 
            ' 
            
            Private Sub ExecuteCommande() 
            
                Dim Boucle As Long, Compteur As Long 
                Dim Valeur As Long 
                 
                ' 3 minutes 
                For Boucle = 1 To 180 
                    ' 1 secondes 
                    For Compteur = 1 To 60 
                        Sleep (1000) 
                    Next Compteur 
                Next Boucle 
            
                MsgBox "Lupin" 
            
            End Sub 
            ' 
            


            Cdt

            Lupin
            0