Alternative timer pour vba

Soyez le premier à donner votre avis sur cette source.

Vue 16 990 fois - Téléchargée 1 753 fois

Description

Bonjour,

Ce code défini une classe d'objet « Timer » permettant de créer des 'Timer' tournant sur de longues durées.
Il a vu le jour suite à un problème rencontré lors du développement d'une macro EXCEL nécessitant l'exécution d?une tâche à intervalle régulier. Le composant 'Timer' n'existant pas sous VBA, et une simple boucle faisant ramer le PC, j'ai créé le mien...

Source / Exemple :


'Contenu de ma classe Timer

Option Explicit

Private localInterval As Long
Private localEnabled As Boolean

Private Type FILETIME
    dwLowDateTime As Long
    dwHighDateTime As Long
End Type

Private TimeOptions As FILETIME  ' Durée transmise à la fonction SetWaitableTimer

Private Declare Function CreateWaitableTimer Lib "kernel32" Alias "CreateWaitableTimerA" (ByVal lpSemaphoreAttributes As Long, ByVal bManualReset As Long, ByVal lpName As String) As Long
Private Declare Function SetWaitableTimer Lib "kernel32" (ByVal hTimer As Long, lpDueTime As FILETIME, ByVal lPeriod As Long, ByVal pfnCompletionRoutine As Long, ByVal lpArgToCompletionRoutine As Long, ByVal fResume As Long) As Long
Private Declare Function CancelWaitableTimer& Lib "kernel32" (ByVal hTimer As Long)
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Private Declare Function MsgWaitForMultipleObjects Lib "user32" (ByVal nCount As Long, pHandles As Long, ByVal fWaitAll As Long, ByVal dwMilliseconds As Long, ByVal dwWakeMask As Long) As Long

Private TimerhWait As Long
Private CancelTimer As Boolean
Private TimerRunning As Boolean

Public Event Timer()

'--------------------------------------------------------------
'Routine de temporisation...
'<vdata> : milisecondes
'<vdata> : <= 0 Annuler l'attente
'<vdata> : > 0 Démarrer la boucle d'attente

Public Property Let interval(vdata As Long)
'Si le Timer est activé
If localEnabled Then
        
    'Reset le drapeau d'annulation
    CancelTimer = False
    
    'Si la durée est inférieur ou égale à zéro
    If vdata <= 0 Then
        'Durée de la temporisation : <vdata> ms
        TimeOptions.dwLowDateTime = -1
        'Mettre à jour la variable locale
        localInterval = vdata
    'Sinon
    Else
        'Si le timer tourne déjà
        If TimerRunning Then
            'Annule le décompte en cours
            CancelWaitableTimer TimerhWait
            'Convertir la nouvelle durée
            TimeOptions.dwLowDateTime = CLng(vdata * -10000)
            'Programmer le déclenchement de l'évènement 'TimerhWait' dans 'TimeOptions' ms
            SetWaitableTimer TimerhWait, TimeOptions, 0, 0, 0, 0
            'Mettre à jour la variable locale
            localInterval = vdata
        'Sinon
        Else
            'Définir localement le timer comme tournant
            TimerRunning = True
            'Mettre à jour la variable locale
            localInterval = vdata
            'Convertir la nouvelle durée
            TimeOptions.dwLowDateTime = CLng(vdata * -10000)
            
            'Boucle infinie (jusqu'à annulation)
            Do Until TimeOptions.dwLowDateTime = -1
                
                'Programmer le déclenchement du prochain évènement 'TimerhWait' dans 'Timeoptions' ms
                SetWaitableTimer TimerhWait, TimeOptions, 0, 0, 0, 0
                
                'Boucle d'attente sans stress (Attendre le déclenchement de l'évènement 'TimerhWait')
                Do While MsgWaitForMultipleObjects(1, TimerhWait, False, &HFFFF, &HFF) > 0
                    DoEvents
                    'If CancelTimer Then Exit Do
                Loop
                
                'Si annulation, sortir de la boucle infinie
                If TimeOptions.dwLowDateTime = -1 Then Exit Do
                
                'Déclenchement de l'évènement 'Timer'
                RaiseEvent Timer
            
            Loop
            
            'Définir localement le timer à l'arrêt
            TimerRunning = False
            
        End If
    End If
'Sinon
Else
    'Mettre à jour la variable locale
    localInterval = vdata
End If
End Property

Public Property Get interval() As Long
    interval = localInterval
End Property

'--------------------------------------------------------------
Public Property Let Enabled(vdata As Boolean)

'Si changement
If vdata <> localEnabled Then
    'Si activation
    If vdata Then
        'Mettre à jour la variable locale
        localEnabled = vdata
        'Si l'intervalle est supérieur à zéro
        If localInterval > 0 Then
            'Mise en route du timer
            Me.interval = localInterval
        End If
    'Sinon
    Else
        'Annulation
        TimeOptions.dwLowDateTime = -1
        'Mettre à jour la variable locale
        localEnabled = vdata
    End If
End If
End Property

Public Property Get Enabled() As Boolean
    Enabled = localEnabled
End Property

'--------------------------------------------------------------
Private Sub Class_Initialize()
    'Création de l'horloge
    TimerhWait = CreateWaitableTimer(0, True, "Timer6RatsMorts")
    'Initialisation de la durée
    TimeOptions.dwHighDateTime = -1
    TimeOptions.dwLowDateTime = -1
End Sub

Private Sub Class_Terminate()
    TimeOptions.dwHighDateTime = -1
    TimeOptions.dwLowDateTime = -1
    CloseHandle TimerhWait
End Sub

Codes Sources

A voir également

Ajouter un commentaire

Commentaires

Messages postés
4
Date d'inscription
mercredi 28 mai 2008
Statut
Membre
Dernière intervention
3 juin 2008

Merci MIMIZANZAN pour toute ton aide! ca marche!
Messages postés
301
Date d'inscription
lundi 27 février 2006
Statut
Membre
Dernière intervention
17 décembre 2017

Désolé CYRIL00063, un bout de phrase a sauté.
Il faut lire:
"mettre le timer directement sur une feuille de calcul(par la boite à outils VBA, autres contrôles)".
Pour que çà marche,il faut rester dans Excel et ouvrir ou créer un nouveau dossier par le menu.
Messages postés
4
Date d'inscription
mercredi 28 mai 2008
Statut
Membre
Dernière intervention
3 juin 2008

Merci de ton aide, mais je dois dire que le bout de phrase incomplet (mettre le timer directement sur...) m'empeche de comprendre ce que tu me conseil...
Ce qui est bizarre c'est que je peux me servir d'excel à partir du moment où j'ouvre un autre fichier à partir d'excel (file/open) mais ca ne marche pas si je l'ouvre directement depuis windows (double clic).
merci!
Messages postés
301
Date d'inscription
lundi 27 février 2006
Statut
Membre
Dernière intervention
17 décembre 2017

Salut CYRIL00063!

Content de savoir que mon timer te convient.
Pour répondre à ta question, il suffit de mettre le timer directement sur une Autres contrôles), et dans la procédure timer_click de la feuille, mettre au début l'instruction Doevents.
Tu peux alors lancer le timer (par un bouton sur la feuille par ex) et ouvrir un autre classeur: le timer continuera de tourner dans son classeur...
Et revoilà!
Messages postés
4
Date d'inscription
mercredi 28 mai 2008
Statut
Membre
Dernière intervention
3 juin 2008

Merci MimiZanzan ca marche super bien! un peu decu tout de meme de ne pas pouvoir trouver une solution aussi simple...
je vais encore devoir vous demander de l'aide: j'aimerais pouvoir utiliser mon excel tranquillement pendant que ma mise a jour tourne. Je penser faire en sorte que ce timer s'ouvre dans un nouvelle application excel. avez vous de meilleurs idée?
Merci!
Afficher les 19 commentaires

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.