Alternative timer pour vba

Télécharger le projet
Commenter

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
Télécharger le projet

Codes Sources

A voir également

S'inscrire maintenant

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.