Précédent   Forum des professionnels en informatique > Logiciels > Microsoft Office > Excel > Macros et VBA Excel
Macros et VBA Excel Vos questions relatives aux macros Excel, à l'utilisation de VBA et à l'automatisation de vos classeurs Excel.
Partagez cette discussion sur d'autres réseaux sociaux : Viadeo Twitter Google Facebook Digg Delicious MySpace Yahoo
Réponse Proposer ce sujet en actualité
 
Outils de la discussion
Publicité
Vieux 02/07/2009, 07h14   #1
Membre du Club
 
Inscription : juillet 2002
Messages : 58
Détails du profil
Informations forums :
Inscription : juillet 2002
Messages : 58
Points : 42
Points : 42
Par défaut Pb Appel fonction API Méthode de classe

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 :
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
__________________
C++ BUILDER & DELPHI
Laurent GAUDILLIER est déconnecté   Envoyer un message privé Réponse avec citation 00
Vieux 02/07/2009, 10h11   #2
Membre Expert
 
Homme Michel
Ingénieur développement logiciels
Inscription : mai 2005
Messages : 1 561
Détails du profil
Informations personnelles :
Nom : Homme Michel
Localisation : France, Val de Marne (Île de France)

Informations professionnelles :
Activité : Ingénieur développement logiciels
Secteur : High Tech - Éditeur de logiciels

Informations forums :
Inscription : mai 2005
Messages : 1 561
Points : 2 105
Points : 2 105
salut,
pour un Timer sans formulaire, voir http://access.developpez.com/sources...ev#TimerSsForm

__________________
"tout le monde veut sauver la planète, mais personne ne veut descendre les poubelles." J Yanne
micniv est déconnecté   Envoyer un message privé Réponse avec citation 00
Vieux 02/07/2009, 10h22   #3
Responsable Access
 
Avatar de Arkham46
 
Inscription : septembre 2003
Messages : 4 220
Détails du profil
Informations personnelles :
Localisation : France, Loiret (Centre)

Informations forums :
Inscription : septembre 2003
Messages : 4 220
Points : 7 734
Points : 7 734
Citation:
Envoyé par Laurent GAUDILLIER Voir le message
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 :
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 :
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 :
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
__________________
Assistant de création/modification de rubans Office
Utilisez en VBA les librairies graphiques GDI, GDI+ et openGL

Blog Office Mon Site DVP
Arkham46 est déconnecté   Envoyer un message privé Réponse avec citation 00
Vieux 02/07/2009, 15h00   #4
Membre du Club
 
Inscription : juillet 2002
Messages : 58
Détails du profil
Informations forums :
Inscription : juillet 2002
Messages : 58
Points : 42
Points : 42
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
__________________
C++ BUILDER & DELPHI
Laurent GAUDILLIER est déconnecté   Envoyer un message privé Réponse avec citation 00
Réponse Proposer ce sujet en actualité Cette discussion est résolue.
Outils de la discussion



Fuseau horaire GMT +1. Il est actuellement 14h41.


 
 
 
 
Partenaires

Hébergement Web