Discussion :

[Laurent GAUDILLIER]

Bonjour à tous

Voila, je vous explique mon Pb, Je désire créer une classe TTimer en VBA
pour se faire j'utilise les Fonctions de l'API Windows : SetTimer et KillTimer

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
 
 
Declare Function SetTimer Lib "user32" Alias "SetTimer" (ByVal hWnd As Long, ByVal nIDEvent As Long, ByVal uElapse As Long, ByVal lpTimerFunc As Long) As Long

Ma question est la suivante:

Le paramètre < lpTimerFunc > attend en principe (AddresseOf: procedureName)
Est t'il possible de passer comme paramètre à lpTimerFunc une methode de ma classe
Si oui comment proceder ?

D'avance merci

[micniv]

salut,
pour un Timer sans formulaire, voir http://access.developpez.com/sources...ev#TimerSsForm

[Arkham46]

Est t'il possible de passer comme paramètre à lpTimerFunc une methode de ma classe

Non, il faut obligatoirement une fonction dans un module standard.
Mais tu peux passer le module de classe en paramètre en utilisant le pointeur de la classe comme identifiant de timer.
Comme ça il est tout de même possible de profiter des modules de classe pour créer des objets Timer.

Le code suivant est testé avec Excel 2002 :

Code Module de classe clTimer :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
 
'***************************************************************************************
'*                             MODULE POUR TIMER                                       *
'***************************************************************************************
' Gestion de timer avec renvoi de l'événement à une instance de classe
'***************************************************************************************
' Auteur : Thierry GASPERMENT (Arkham46)
' Le code est libre pour toute utilisation
'***************************************************************************************
Option Explicit
'***************************************************************************************
'*                                 VARIABLES                                           *
'***************************************************************************************
Private gHwnd As Long
Private gTimerStarted As Boolean
'***************************************************************************************
'*                                 EVENEMENTS                                          *
'***************************************************************************************
Public Event OnTimer()
'***************************************************************************************
'*                                       API                                           *
'***************************************************************************************
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" _
        (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
' Déclaration d'API pour timer
Private Declare Function APISetTimer Lib "user32.dll" Alias "SetTimer" _
        (ByVal hwnd As Long, ByVal nIDEvent As Long, ByVal uElapse As Long, ByVal lpTimerProc As Long) As Long
Private Declare Function APIKillTimer Lib "user32.dll" Alias "KillTimer" _
        (ByVal hwnd As Long, ByVal uIDEvent As Long) As Long
'***************************************************************************************
'*                                    FONCTIONS                                        *
'***************************************************************************************
' Démarre le timer (interval en ms)
Public Sub StartTimer(interval As Long)
    Dim lHwnd As Long
    lHwnd = FindWindow("xlMain", Application.Caption)
    If lHwnd <> 0 Then
        gTimerStarted = (APISetTimer(lHwnd, ObjPtr(Me), interval, AddressOf Callback_Timer) <> 0)
        gHwnd = lHwnd
    Else
        gTimerStarted = False
    End If
End Sub
' Arrête le timer ()
Public Sub StopTimer()
    If gTimerStarted Then APIKillTimer gHwnd, ObjPtr(Me)
End Sub
 
Public Sub TimerProc()
    On Error Resume Next
    RaiseEvent OnTimer
End Sub
 
Private Sub Class_Terminate()
    If gTimerStarted Then StopTimer
End Sub

Code Module standard ModTimer :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
 
'***************************************************************************************
'*                             MODULE POUR TIMER                                       *
'***************************************************************************************
' Gestion de timer avec renvoi de l'événement à une instance de classe
'***************************************************************************************
' Auteur : Thierry GASPERMENT (Arkham46)
' Le code est libre pour toute utilisation
'***************************************************************************************
Option Explicit
'***************************************************************************************
'*                                    FONCTIONS                                        *
'***************************************************************************************
' Callback_Timer est appelé par les timers à intervalle régulier
' wparam contient la classe qui a initié le timer
Public Function Callback_Timer(ByVal hwnd As Long, ByVal uMsg As Long, ByVal wParam As clTimer, ByVal lParam As Long) As Long
' Citation de l'aide de AddressOf :
'Étant donné que l'appelant d'un rappel ne se trouve pas dans votre programme,
'il est important qu'une erreur rencontrée dans la procédure de rappel ne se propage pas
'dans l'appelant. Pour ce faire, insérez l'instruction On Error Resume Next
'au début de la procédure de rappel.
    On Error Resume Next
    ' renvoie l'événement à la classe qui a initié le timer
    wParam.TimerProc
End Function

Code Exécution des timers dans ThisWorkBook :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
 
Option Explicit
 
' 2 timers avec événement (on doit être dans un objet de classe pour utiliser WithEvents)
Private WithEvents oTimer1 As clTimer
Private WithEvents oTimer2 As clTimer
 
' Démarre les 2 timers
Function StartTimer()
Set oTimer1 = New clTimer
Set oTimer2 = New clTimer
oTimer1.StartTimer 1000
oTimer2.StartTimer 2000
End Function
 
' Arrête les 2 timers
Function StopTimer()
oTimer1.StopTimer
oTimer2.StopTimer
End Function
 
' Sur Timer 1
Private Sub oTimer1_OnTimer()
Debug.Print "Timer1", Now
End Sub
 
' Sur Timer 2
Private Sub oTimer2_OnTimer()
Debug.Print "Timer2", Now
End Sub

[Laurent GAUDILLIER]

Merci à toi Arkham46 il est vrai que je n'avais pas vu les choses sous cet angle !!!

Ta classe me parait interssante, je vais d'ailleurs m'en inspirer ....

Encore une fois un grand merci à vous tous et plus particulièrement à
Arkham46

Bonne journée à tous

Sincères salutation

Laurent