Exécution d'une macro chaque jour

Question

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


Configuration: Windows XP / Firefox 3.0.19

Utilisateur anonyme · Answer

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

Utilisateur anonyme · Answer

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

jijilamara7777 · Answer

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

eriiic · Answer

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

Utilisateur anonyme · Answer

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

Utilisateur anonyme · Answer

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

Utilisateur anonyme · Answer

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

Exécution d'une macro chaque jour

7 réponses

Votre réponse

Discussions similaires

Newsletters