Création d'un timer sous Excel en VBA

Le
Lolo
Comment créer un timer sous Excel en VBA qui aille faire une action
périodiquement.
Vos réponses Page 2 / 2
Gagnez chaque mois un abonnement Premium avec GNT : Inscrivez-vous !
Trier par : date / pertinence
Mgr Banni
Le #4998461
merdum, lolo, s'écria le vénéré en question et en latin
il se peut que le code proposé par FS ne soit plus acceptable pour des
versions XL supérieures à 2000...
si denis muchon devait passer dans le quartier (quartier que désertent de
plus en plus les MVP auxquels, donc, je ne pense même pas à faire appel), il
saurait nous dire ce qu'est cette dll manquante, lui qui est toujours avec
son XL 5 et son Win 3.1
croisons les doigts, mon fils, pour que la voiture-balai vienne jusqu'à nous
Mgr T.B.

"Lolo"
Vénéré Mgr Banni,

Ho esprit supérieur !
Ho toi qui par dela les apparences percoit la réalité ultime,

je te remercie d'avoir répondu au misérable insecte sans cervelle que je
suis.

Néanmoins l'implémentation du code extraordinaire proposé n'est pas sans
difficulté.
--> absence de la dll vba232

Note je travaille sous Excel 2002, c'est un poste professionnel.

Votre éternellement dévoué et reconnaissant.

Lolo.




bonjour lolo
si tu ne salue pas l'éminence (grise, évidemment, surtou au sortir de la
cave) que je suis, peut-être aurais-tu pu adresser de collégiales
salutations à ce forum où, entre chibanis et chaouches, tu sauras qu'il
n'y
a que des bénévoles susceptibles de t'aider et non des gens de Microsoft
qui
ne sont ici que pour censurer, souvent mal à propos d'aillleurs, certains
messages, souvent bien anodins...
ceci dit, je te fais copie d'un texte, un peu long certes mais tellement
documenté, qu'avait écrit F. Sigonneau au sujet du Timer, il y a de cela
bien longtemps comme tu auras pu en juger mais les écrits de notre MVP de
compétition, c'est comme le vin : ils se bonifient en vieillisant
début de copie

Bonjour,

Une solution API avec un Timer (mais qui nécessite Excel 97 ou 2000).

Dans ton classeur, recopie dans un module standard le code suivant :

Option Explicit

'====================================== >>
'Pour utiliser un Timer avec Excel 97-2000 :

'recopier ce code dans un module standard, puis :

'

'1-créez dans un *module standard* une procédure sur ce modèle:

' Sub TimerExecute()

' 'code à exécuter lorsque le Timer s'active

'End Sub

'

'2-dans une procédure événementielle ou affectée à un bouton

'créez un Timer par l'instruction :

' LanceTimer 10000

'(10000 est l'intervalle d'activation du Timer. L'intervalle

's'exprime en millisecondes. Dans cet exemple, la procédure

'TimerExecute est exécutée toutes les 10 secondes)

'

'3-détruisez le Timer lorsque vous n'en avez plus besoin par

'l'instruction :

' StopTimer

'

'Ce code utilise la fonction AddrOf de Ken Getz and Michael Kaplan

'qui "émule" l'opérateur AddressOf de VBA6.

'Remerciements à LL pour ses différents posts à ce sujet sur mpfe

'FS

'======================================= >>
Private Declare Function SetTimer Lib "user32" _

(ByVal hWnd As Long, ByVal nIDEvent As Long, _

ByVal uElapse As Long, ByVal lpTimerFunc As Long) As Long

Private Declare Function KillTimer Lib "user32" _

(ByVal hWnd As Long, ByVal nIDEvent As Long) As Long

Private Declare Function GetCurrentVbaProject Lib "vba332.dll" _

Alias "EbGetExecutingProj" (hProject As Long) As Long

Private Declare Function GetFuncID Lib "vba332.dll" Alias

"TipGetFunctionId" _

(ByVal hProject As Long, ByVal strFunctionName As String, _

ByRef strFunctionID As String) As Long

Private Declare Function GetAddr Lib "vba332.dll" Alias

"TipGetLpfnOfFunctionId" _

(ByVal hProject As Long, ByVal strFunctionID As String, _

ByRef lpfnAddressOf As Long) As Long

Dim TimerID As Long

#If VBA6 Then

#Else

Private Function AddrOf(CallbackFunctionName As String) As Long

'AddressOf operator replacement for Office97 VBA

'Authors: Ken Getz and Michael Kaplan

'

'declaration of local variables

Dim aResult As Long

Dim CurrentVBProject As Long

Dim strFunctionID As String

Dim AddressOfFunction As Long

Dim UnicodeFunctionName As String

'

'convert the name of the function to Unicode system

UnicodeFunctionName = StrConv(CallbackFunctionName, vbUnicode)

'

'if the current VBProjects exists...

If Not GetCurrentVbaProject(CurrentVBProject) = 0 Then

'...get the function ID of the callback function, based on its

'unicode-converted name, in order to ensure that it exists

aResult = GetFuncID _

( _

hProject:=CurrentVBProject, _

strFunctionName:=UnicodeFunctionName, _

strFunctionID:=strFunctionID _

)

'if the function exists indeed ...

If aResult = 0 Then

'...get a pointer to the callback function based on

'the strFunctionID argument of the GetFuncID function

aResult = GetAddr _

( _

hProject:=CurrentVBProject, _

strFunctionID:=strFunctionID, _

lpfnAddressOf:­dressOfFunction _

)

'if we've got the pointer pass it to the result

'of the function

If aResult = 0 Then

AddrOf = AddressOfFunction

End If

End If

End If

End Function

#End If

Sub LanceTimer(Interval As Long)

#If VBA6 Then

TimerID = SetTimer(0, 0, Interval, AddressOf TimerExecute)

#Else

TimerID = SetTimer(0, 0, Interval, AddrOf("TimerExecute"))

#End If

End Sub

Sub StopTimer()

KillTimer 0, TimerID

End Sub

puis dans un autre module standard, tu vas préparer les procédures dont

tu as besoin pour créer, détruire le timer et lui dire ce qu'il doit

faire. Par exemple :

'====================== >>
Sub TimerExecute()

'la procédure qui est lancée à chaque déclenchement du timer

If Time > "00:00:00" And Time < "00:15:00" Then

'le code a exécuter entre minuit et minuit 15

End If

End Sub

Sub CreeTimer()

LanceTimer 900000 'déclenchement toutes les 15 minutes

End Sub

Sub FinTimer()

StopTimer

End Sub

'======================= >>
Dans cet exemple, le timer vérifie l'heure tous les quarts d'heure et,

s'il est entre minuit et minuit et quart, fait ce que tu veux.

Tu peux placer un appel à CreeTimer dans l'événement Workbook_Open de

ton classeur et un appel à FinTimer dans l'événement

Workbook_BeforeClose, ou l'appeler et l'arrêter "à la main" en reliant

ces deux procédures à des boutons dans une barre d'outils.

EQCTA, comme dirait Thomas, qui t'a proposé une solution nettement plus

simple :-)

(mais ça m'a permis de travailler la compilation conditionnelle!)

fin de copie

j'avais prévenu : un peu long

HTH

Mgr T.Banni


"Lolo"
Comment créer un timer sous Excel en VBA qui aille faire une action
périodiquement.








MichDenis
Le #4998271
Vba232.dll mis à jour disponible à Centre de téléchargement

http://support.microsoft.com/kb/147529/fr

Ce que FS via Msg fonctionne bien. Enregistre ton classeur souvent
car quand ça plante, excel se ferme sur le champ !!!





"Lolo"
Vénéré Mgr Banni,

Ho esprit supérieur !
Ho toi qui par dela les apparences percoit la réalité ultime,

je te remercie d'avoir répondu au misérable insecte sans cervelle que je suis.

Néanmoins l'implémentation du code extraordinaire proposé n'est pas sans
difficulté.
--> absence de la dll vba232

Note je travaille sous Excel 2002, c'est un poste professionnel.

Votre éternellement dévoué et reconnaissant.

Lolo.




bonjour lolo
si tu ne salue pas l'éminence (grise, évidemment, surtou au sortir de la
cave) que je suis, peut-être aurais-tu pu adresser de collégiales
salutations à ce forum où, entre chibanis et chaouches, tu sauras qu'il n'y
a que des bénévoles susceptibles de t'aider et non des gens de Microsoft qui
ne sont ici que pour censurer, souvent mal à propos d'aillleurs, certains
messages, souvent bien anodins...
ceci dit, je te fais copie d'un texte, un peu long certes mais tellement
documenté, qu'avait écrit F. Sigonneau au sujet du Timer, il y a de cela
bien longtemps comme tu auras pu en juger mais les écrits de notre MVP de
compétition, c'est comme le vin : ils se bonifient en vieillisant
début de copie

Bonjour,

Une solution API avec un Timer (mais qui nécessite Excel 97 ou 2000).

Dans ton classeur, recopie dans un module standard le code suivant :

Option Explicit

'====================================== >
'Pour utiliser un Timer avec Excel 97-2000 :

'recopier ce code dans un module standard, puis :

'

'1-créez dans un *module standard* une procédure sur ce modèle:

' Sub TimerExecute()

' 'code à exécuter lorsque le Timer s'active

'End Sub

'

'2-dans une procédure événementielle ou affectée à un bouton

'créez un Timer par l'instruction :

' LanceTimer 10000

'(10000 est l'intervalle d'activation du Timer. L'intervalle

's'exprime en millisecondes. Dans cet exemple, la procédure

'TimerExecute est exécutée toutes les 10 secondes)

'

'3-détruisez le Timer lorsque vous n'en avez plus besoin par

'l'instruction :

' StopTimer

'

'Ce code utilise la fonction AddrOf de Ken Getz and Michael Kaplan

'qui "émule" l'opérateur AddressOf de VBA6.

'Remerciements à LL pour ses différents posts à ce sujet sur mpfe

'FS

'======================================= >
Private Declare Function SetTimer Lib "user32" _

(ByVal hWnd As Long, ByVal nIDEvent As Long, _

ByVal uElapse As Long, ByVal lpTimerFunc As Long) As Long

Private Declare Function KillTimer Lib "user32" _

(ByVal hWnd As Long, ByVal nIDEvent As Long) As Long

Private Declare Function GetCurrentVbaProject Lib "vba332.dll" _

Alias "EbGetExecutingProj" (hProject As Long) As Long

Private Declare Function GetFuncID Lib "vba332.dll" Alias

"TipGetFunctionId" _

(ByVal hProject As Long, ByVal strFunctionName As String, _

ByRef strFunctionID As String) As Long

Private Declare Function GetAddr Lib "vba332.dll" Alias

"TipGetLpfnOfFunctionId" _

(ByVal hProject As Long, ByVal strFunctionID As String, _

ByRef lpfnAddressOf As Long) As Long

Dim TimerID As Long

#If VBA6 Then

#Else

Private Function AddrOf(CallbackFunctionName As String) As Long

'AddressOf operator replacement for Office97 VBA

'Authors: Ken Getz and Michael Kaplan

'

'declaration of local variables

Dim aResult As Long

Dim CurrentVBProject As Long

Dim strFunctionID As String

Dim AddressOfFunction As Long

Dim UnicodeFunctionName As String

'

'convert the name of the function to Unicode system

UnicodeFunctionName = StrConv(CallbackFunctionName, vbUnicode)

'

'if the current VBProjects exists...

If Not GetCurrentVbaProject(CurrentVBProject) = 0 Then

'...get the function ID of the callback function, based on its

'unicode-converted name, in order to ensure that it exists

aResult = GetFuncID _

( _

hProject:=CurrentVBProject, _

strFunctionName:=UnicodeFunctionName, _

strFunctionID:=strFunctionID _

)

'if the function exists indeed ...

If aResult = 0 Then

'...get a pointer to the callback function based on

'the strFunctionID argument of the GetFuncID function

aResult = GetAddr _

( _

hProject:=CurrentVBProject, _

strFunctionID:=strFunctionID, _

lpfnAddressOf:­dressOfFunction _

)

'if we've got the pointer pass it to the result

'of the function

If aResult = 0 Then

AddrOf = AddressOfFunction

End If

End If

End If

End Function

#End If

Sub LanceTimer(Interval As Long)

#If VBA6 Then

TimerID = SetTimer(0, 0, Interval, AddressOf TimerExecute)

#Else

TimerID = SetTimer(0, 0, Interval, AddrOf("TimerExecute"))

#End If

End Sub

Sub StopTimer()

KillTimer 0, TimerID

End Sub

puis dans un autre module standard, tu vas préparer les procédures dont

tu as besoin pour créer, détruire le timer et lui dire ce qu'il doit

faire. Par exemple :

'====================== >
Sub TimerExecute()

'la procédure qui est lancée à chaque déclenchement du timer

If Time > "00:00:00" And Time < "00:15:00" Then

'le code a exécuter entre minuit et minuit 15

End If

End Sub

Sub CreeTimer()

LanceTimer 900000 'déclenchement toutes les 15 minutes

End Sub

Sub FinTimer()

StopTimer

End Sub

'======================= >
Dans cet exemple, le timer vérifie l'heure tous les quarts d'heure et,

s'il est entre minuit et minuit et quart, fait ce que tu veux.

Tu peux placer un appel à CreeTimer dans l'événement Workbook_Open de

ton classeur et un appel à FinTimer dans l'événement

Workbook_BeforeClose, ou l'appeler et l'arrêter "à la main" en reliant

ces deux procédures à des boutons dans une barre d'outils.

EQCTA, comme dirait Thomas, qui t'a proposé une solution nettement plus

simple :-)

(mais ça m'a permis de travailler la compilation conditionnelle!)

fin de copie

j'avais prévenu : un peu long

HTH

Mgr T.Banni


"Lolo"
Comment créer un timer sous Excel en VBA qui aille faire une action
périodiquement.






Mgr Banni
Le #4998261
lolo, dis merci à denis qui a beaucoup de mérite de se pencher sur les
bafouillages de ton vénéré Mgr
T.B.

"MichDenis"
Vba232.dll mis à jour disponible à Centre de téléchargement

http://support.microsoft.com/kb/147529/fr

Ce que FS via Msg fonctionne bien. Enregistre ton classeur souvent
car quand ça plante, excel se ferme sur le champ !!!





"Lolo"
Vénéré Mgr Banni,

Ho esprit supérieur !
Ho toi qui par dela les apparences percoit la réalité ultime,

je te remercie d'avoir répondu au misérable insecte sans cervelle que je
suis.

Néanmoins l'implémentation du code extraordinaire proposé n'est pas sans
difficulté.
--> absence de la dll vba232

Note je travaille sous Excel 2002, c'est un poste professionnel.

Votre éternellement dévoué et reconnaissant.

Lolo.




bonjour lolo
si tu ne salue pas l'éminence (grise, évidemment, surtou au sortir de la
cave) que je suis, peut-être aurais-tu pu adresser de collégiales
salutations à ce forum où, entre chibanis et chaouches, tu sauras qu'il
n'y
a que des bénévoles susceptibles de t'aider et non des gens de Microsoft
qui
ne sont ici que pour censurer, souvent mal à propos d'aillleurs, certains
messages, souvent bien anodins...
ceci dit, je te fais copie d'un texte, un peu long certes mais tellement
documenté, qu'avait écrit F. Sigonneau au sujet du Timer, il y a de cela
bien longtemps comme tu auras pu en juger mais les écrits de notre MVP de
compétition, c'est comme le vin : ils se bonifient en vieillisant
début de copie

Bonjour,

Une solution API avec un Timer (mais qui nécessite Excel 97 ou 2000).

Dans ton classeur, recopie dans un module standard le code suivant :

Option Explicit

'====================================== >>
'Pour utiliser un Timer avec Excel 97-2000 :

'recopier ce code dans un module standard, puis :

'

'1-créez dans un *module standard* une procédure sur ce modèle:

' Sub TimerExecute()

' 'code à exécuter lorsque le Timer s'active

'End Sub

'

'2-dans une procédure événementielle ou affectée à un bouton

'créez un Timer par l'instruction :

' LanceTimer 10000

'(10000 est l'intervalle d'activation du Timer. L'intervalle

's'exprime en millisecondes. Dans cet exemple, la procédure

'TimerExecute est exécutée toutes les 10 secondes)

'

'3-détruisez le Timer lorsque vous n'en avez plus besoin par

'l'instruction :

' StopTimer

'

'Ce code utilise la fonction AddrOf de Ken Getz and Michael Kaplan

'qui "émule" l'opérateur AddressOf de VBA6.

'Remerciements à LL pour ses différents posts à ce sujet sur mpfe

'FS

'======================================= >>
Private Declare Function SetTimer Lib "user32" _

(ByVal hWnd As Long, ByVal nIDEvent As Long, _

ByVal uElapse As Long, ByVal lpTimerFunc As Long) As Long

Private Declare Function KillTimer Lib "user32" _

(ByVal hWnd As Long, ByVal nIDEvent As Long) As Long

Private Declare Function GetCurrentVbaProject Lib "vba332.dll" _

Alias "EbGetExecutingProj" (hProject As Long) As Long

Private Declare Function GetFuncID Lib "vba332.dll" Alias

"TipGetFunctionId" _

(ByVal hProject As Long, ByVal strFunctionName As String, _

ByRef strFunctionID As String) As Long

Private Declare Function GetAddr Lib "vba332.dll" Alias

"TipGetLpfnOfFunctionId" _

(ByVal hProject As Long, ByVal strFunctionID As String, _

ByRef lpfnAddressOf As Long) As Long

Dim TimerID As Long

#If VBA6 Then

#Else

Private Function AddrOf(CallbackFunctionName As String) As Long

'AddressOf operator replacement for Office97 VBA

'Authors: Ken Getz and Michael Kaplan

'

'declaration of local variables

Dim aResult As Long

Dim CurrentVBProject As Long

Dim strFunctionID As String

Dim AddressOfFunction As Long

Dim UnicodeFunctionName As String

'

'convert the name of the function to Unicode system

UnicodeFunctionName = StrConv(CallbackFunctionName, vbUnicode)

'

'if the current VBProjects exists...

If Not GetCurrentVbaProject(CurrentVBProject) = 0 Then

'...get the function ID of the callback function, based on its

'unicode-converted name, in order to ensure that it exists

aResult = GetFuncID _

( _

hProject:=CurrentVBProject, _

strFunctionName:=UnicodeFunctionName, _

strFunctionID:=strFunctionID _

)

'if the function exists indeed ...

If aResult = 0 Then

'...get a pointer to the callback function based on

'the strFunctionID argument of the GetFuncID function

aResult = GetAddr _

( _

hProject:=CurrentVBProject, _

strFunctionID:=strFunctionID, _

lpfnAddressOf:­dressOfFunction _

)

'if we've got the pointer pass it to the result

'of the function

If aResult = 0 Then

AddrOf = AddressOfFunction

End If

End If

End If

End Function

#End If

Sub LanceTimer(Interval As Long)

#If VBA6 Then

TimerID = SetTimer(0, 0, Interval, AddressOf TimerExecute)

#Else

TimerID = SetTimer(0, 0, Interval, AddrOf("TimerExecute"))

#End If

End Sub

Sub StopTimer()

KillTimer 0, TimerID

End Sub

puis dans un autre module standard, tu vas préparer les procédures dont

tu as besoin pour créer, détruire le timer et lui dire ce qu'il doit

faire. Par exemple :

'====================== >>
Sub TimerExecute()

'la procédure qui est lancée à chaque déclenchement du timer

If Time > "00:00:00" And Time < "00:15:00" Then

'le code a exécuter entre minuit et minuit 15

End If

End Sub

Sub CreeTimer()

LanceTimer 900000 'déclenchement toutes les 15 minutes

End Sub

Sub FinTimer()

StopTimer

End Sub

'======================= >>
Dans cet exemple, le timer vérifie l'heure tous les quarts d'heure et,

s'il est entre minuit et minuit et quart, fait ce que tu veux.

Tu peux placer un appel à CreeTimer dans l'événement Workbook_Open de

ton classeur et un appel à FinTimer dans l'événement

Workbook_BeforeClose, ou l'appeler et l'arrêter "à la main" en reliant

ces deux procédures à des boutons dans une barre d'outils.

EQCTA, comme dirait Thomas, qui t'a proposé une solution nettement plus

simple :-)

(mais ça m'a permis de travailler la compilation conditionnelle!)

fin de copie

j'avais prévenu : un peu long

HTH

Mgr T.Banni


"Lolo"
Comment créer un timer sous Excel en VBA qui aille faire une action
périodiquement.










MichDenis
Le #4998251
Pour remplacer ce Microsoft n'arrive plus à donner comme service,
fait appel à "Google Bar" qui est un petit utilitaire de recherche
extrêmement rapide et efficace. Il est gratuit et téléchargeable
de plusieurs sites internet. En voici un :
http://www.infos-du-net.com/telecharger/Google-bar,0305-7869.html

Cet utilitaire s'utilise avec IE ou Firefox.

Et si tu veux avoir une réponse d'un MVP, tu vas sur le forum anglophone
il y en a quelques représentants presque continuellement de disponible !






"Mgr Banni" er$
merdum, lolo, s'écria le vénéré en question et en latin
il se peut que le code proposé par FS ne soit plus acceptable pour des
versions XL supérieures à 2000...
si denis muchon devait passer dans le quartier (quartier que désertent de
plus en plus les MVP auxquels, donc, je ne pense même pas à faire appel), il
saurait nous dire ce qu'est cette dll manquante, lui qui est toujours avec
son XL 5 et son Win 3.1
croisons les doigts, mon fils, pour que la voiture-balai vienne jusqu'à nous
Mgr T.B.

"Lolo"
Vénéré Mgr Banni,

Ho esprit supérieur !
Ho toi qui par dela les apparences percoit la réalité ultime,

je te remercie d'avoir répondu au misérable insecte sans cervelle que je
suis.

Néanmoins l'implémentation du code extraordinaire proposé n'est pas sans
difficulté.
--> absence de la dll vba232

Note je travaille sous Excel 2002, c'est un poste professionnel.

Votre éternellement dévoué et reconnaissant.

Lolo.




bonjour lolo
si tu ne salue pas l'éminence (grise, évidemment, surtou au sortir de la
cave) que je suis, peut-être aurais-tu pu adresser de collégiales
salutations à ce forum où, entre chibanis et chaouches, tu sauras qu'il
n'y
a que des bénévoles susceptibles de t'aider et non des gens de Microsoft
qui
ne sont ici que pour censurer, souvent mal à propos d'aillleurs, certains
messages, souvent bien anodins...
ceci dit, je te fais copie d'un texte, un peu long certes mais tellement
documenté, qu'avait écrit F. Sigonneau au sujet du Timer, il y a de cela
bien longtemps comme tu auras pu en juger mais les écrits de notre MVP de
compétition, c'est comme le vin : ils se bonifient en vieillisant
début de copie

Bonjour,

Une solution API avec un Timer (mais qui nécessite Excel 97 ou 2000).

Dans ton classeur, recopie dans un module standard le code suivant :

Option Explicit

'====================================== >>
'Pour utiliser un Timer avec Excel 97-2000 :

'recopier ce code dans un module standard, puis :

'

'1-créez dans un *module standard* une procédure sur ce modèle:

' Sub TimerExecute()

' 'code à exécuter lorsque le Timer s'active

'End Sub

'

'2-dans une procédure événementielle ou affectée à un bouton

'créez un Timer par l'instruction :

' LanceTimer 10000

'(10000 est l'intervalle d'activation du Timer. L'intervalle

's'exprime en millisecondes. Dans cet exemple, la procédure

'TimerExecute est exécutée toutes les 10 secondes)

'

'3-détruisez le Timer lorsque vous n'en avez plus besoin par

'l'instruction :

' StopTimer

'

'Ce code utilise la fonction AddrOf de Ken Getz and Michael Kaplan

'qui "émule" l'opérateur AddressOf de VBA6.

'Remerciements à LL pour ses différents posts à ce sujet sur mpfe

'FS

'======================================= >>
Private Declare Function SetTimer Lib "user32" _

(ByVal hWnd As Long, ByVal nIDEvent As Long, _

ByVal uElapse As Long, ByVal lpTimerFunc As Long) As Long

Private Declare Function KillTimer Lib "user32" _

(ByVal hWnd As Long, ByVal nIDEvent As Long) As Long

Private Declare Function GetCurrentVbaProject Lib "vba332.dll" _

Alias "EbGetExecutingProj" (hProject As Long) As Long

Private Declare Function GetFuncID Lib "vba332.dll" Alias

"TipGetFunctionId" _

(ByVal hProject As Long, ByVal strFunctionName As String, _

ByRef strFunctionID As String) As Long

Private Declare Function GetAddr Lib "vba332.dll" Alias

"TipGetLpfnOfFunctionId" _

(ByVal hProject As Long, ByVal strFunctionID As String, _

ByRef lpfnAddressOf As Long) As Long

Dim TimerID As Long

#If VBA6 Then

#Else

Private Function AddrOf(CallbackFunctionName As String) As Long

'AddressOf operator replacement for Office97 VBA

'Authors: Ken Getz and Michael Kaplan

'

'declaration of local variables

Dim aResult As Long

Dim CurrentVBProject As Long

Dim strFunctionID As String

Dim AddressOfFunction As Long

Dim UnicodeFunctionName As String

'

'convert the name of the function to Unicode system

UnicodeFunctionName = StrConv(CallbackFunctionName, vbUnicode)

'

'if the current VBProjects exists...

If Not GetCurrentVbaProject(CurrentVBProject) = 0 Then

'...get the function ID of the callback function, based on its

'unicode-converted name, in order to ensure that it exists

aResult = GetFuncID _

( _

hProject:=CurrentVBProject, _

strFunctionName:=UnicodeFunctionName, _

strFunctionID:=strFunctionID _

)

'if the function exists indeed ...

If aResult = 0 Then

'...get a pointer to the callback function based on

'the strFunctionID argument of the GetFuncID function

aResult = GetAddr _

( _

hProject:=CurrentVBProject, _

strFunctionID:=strFunctionID, _

lpfnAddressOf:­dressOfFunction _

)

'if we've got the pointer pass it to the result

'of the function

If aResult = 0 Then

AddrOf = AddressOfFunction

End If

End If

End If

End Function

#End If

Sub LanceTimer(Interval As Long)

#If VBA6 Then

TimerID = SetTimer(0, 0, Interval, AddressOf TimerExecute)

#Else

TimerID = SetTimer(0, 0, Interval, AddrOf("TimerExecute"))

#End If

End Sub

Sub StopTimer()

KillTimer 0, TimerID

End Sub

puis dans un autre module standard, tu vas préparer les procédures dont

tu as besoin pour créer, détruire le timer et lui dire ce qu'il doit

faire. Par exemple :

'====================== >>
Sub TimerExecute()

'la procédure qui est lancée à chaque déclenchement du timer

If Time > "00:00:00" And Time < "00:15:00" Then

'le code a exécuter entre minuit et minuit 15

End If

End Sub

Sub CreeTimer()

LanceTimer 900000 'déclenchement toutes les 15 minutes

End Sub

Sub FinTimer()

StopTimer

End Sub

'======================= >>
Dans cet exemple, le timer vérifie l'heure tous les quarts d'heure et,

s'il est entre minuit et minuit et quart, fait ce que tu veux.

Tu peux placer un appel à CreeTimer dans l'événement Workbook_Open de

ton classeur et un appel à FinTimer dans l'événement

Workbook_BeforeClose, ou l'appeler et l'arrêter "à la main" en reliant

ces deux procédures à des boutons dans une barre d'outils.

EQCTA, comme dirait Thomas, qui t'a proposé une solution nettement plus

simple :-)

(mais ça m'a permis de travailler la compilation conditionnelle!)

fin de copie

j'avais prévenu : un peu long

HTH

Mgr T.Banni


"Lolo"
Comment créer un timer sous Excel en VBA qui aille faire une action
périodiquement.








Lolo
Le #4998121
Merci cher Denis, Merci vénéré Mgr,
Car le Timer fonctionne aussi brillament que vos cerveaux limpides.



lolo, dis merci à denis qui a beaucoup de mérite de se pencher sur les
bafouillages de ton vénéré Mgr
T.B.

"MichDenis"
Vba232.dll mis à jour disponible à Centre de téléchargement

http://support.microsoft.com/kb/147529/fr

Ce que FS via Msg fonctionne bien. Enregistre ton classeur souvent
car quand ça plante, excel se ferme sur le champ !!!





"Lolo"
Vénéré Mgr Banni,

Ho esprit supérieur !
Ho toi qui par dela les apparences percoit la réalité ultime,

je te remercie d'avoir répondu au misérable insecte sans cervelle que je
suis.

Néanmoins l'implémentation du code extraordinaire proposé n'est pas sans
difficulté.
--> absence de la dll vba232

Note je travaille sous Excel 2002, c'est un poste professionnel.

Votre éternellement dévoué et reconnaissant.

Lolo.




bonjour lolo
si tu ne salue pas l'éminence (grise, évidemment, surtou au sortir de la
cave) que je suis, peut-être aurais-tu pu adresser de collégiales
salutations à ce forum où, entre chibanis et chaouches, tu sauras qu'il
n'y
a que des bénévoles susceptibles de t'aider et non des gens de Microsoft
qui
ne sont ici que pour censurer, souvent mal à propos d'aillleurs, certains
messages, souvent bien anodins...
ceci dit, je te fais copie d'un texte, un peu long certes mais tellement
documenté, qu'avait écrit F. Sigonneau au sujet du Timer, il y a de cela
bien longtemps comme tu auras pu en juger mais les écrits de notre MVP de
compétition, c'est comme le vin : ils se bonifient en vieillisant
début de copie

Bonjour,

Une solution API avec un Timer (mais qui nécessite Excel 97 ou 2000).

Dans ton classeur, recopie dans un module standard le code suivant :

Option Explicit

'====================================== > >>
'Pour utiliser un Timer avec Excel 97-2000 :

'recopier ce code dans un module standard, puis :

'

'1-créez dans un *module standard* une procédure sur ce modèle:

' Sub TimerExecute()

' 'code à exécuter lorsque le Timer s'active

'End Sub

'

'2-dans une procédure événementielle ou affectée à un bouton

'créez un Timer par l'instruction :

' LanceTimer 10000

'(10000 est l'intervalle d'activation du Timer. L'intervalle

's'exprime en millisecondes. Dans cet exemple, la procédure

'TimerExecute est exécutée toutes les 10 secondes)

'

'3-détruisez le Timer lorsque vous n'en avez plus besoin par

'l'instruction :

' StopTimer

'

'Ce code utilise la fonction AddrOf de Ken Getz and Michael Kaplan

'qui "émule" l'opérateur AddressOf de VBA6.

'Remerciements à LL pour ses différents posts à ce sujet sur mpfe

'FS

'======================================= > >>
Private Declare Function SetTimer Lib "user32" _

(ByVal hWnd As Long, ByVal nIDEvent As Long, _

ByVal uElapse As Long, ByVal lpTimerFunc As Long) As Long

Private Declare Function KillTimer Lib "user32" _

(ByVal hWnd As Long, ByVal nIDEvent As Long) As Long

Private Declare Function GetCurrentVbaProject Lib "vba332.dll" _

Alias "EbGetExecutingProj" (hProject As Long) As Long

Private Declare Function GetFuncID Lib "vba332.dll" Alias

"TipGetFunctionId" _

(ByVal hProject As Long, ByVal strFunctionName As String, _

ByRef strFunctionID As String) As Long

Private Declare Function GetAddr Lib "vba332.dll" Alias

"TipGetLpfnOfFunctionId" _

(ByVal hProject As Long, ByVal strFunctionID As String, _

ByRef lpfnAddressOf As Long) As Long

Dim TimerID As Long

#If VBA6 Then

#Else

Private Function AddrOf(CallbackFunctionName As String) As Long

'AddressOf operator replacement for Office97 VBA

'Authors: Ken Getz and Michael Kaplan

'

'declaration of local variables

Dim aResult As Long

Dim CurrentVBProject As Long

Dim strFunctionID As String

Dim AddressOfFunction As Long

Dim UnicodeFunctionName As String

'

'convert the name of the function to Unicode system

UnicodeFunctionName = StrConv(CallbackFunctionName, vbUnicode)

'

'if the current VBProjects exists...

If Not GetCurrentVbaProject(CurrentVBProject) = 0 Then

'...get the function ID of the callback function, based on its

'unicode-converted name, in order to ensure that it exists

aResult = GetFuncID _

( _

hProject:=CurrentVBProject, _

strFunctionName:=UnicodeFunctionName, _

strFunctionID:=strFunctionID _

)

'if the function exists indeed ...

If aResult = 0 Then

'...get a pointer to the callback function based on

'the strFunctionID argument of the GetFuncID function

aResult = GetAddr _

( _

hProject:=CurrentVBProject, _

strFunctionID:=strFunctionID, _

lpfnAddressOf:­dressOfFunction _

)

'if we've got the pointer pass it to the result

'of the function

If aResult = 0 Then

AddrOf = AddressOfFunction

End If

End If

End If

End Function

#End If

Sub LanceTimer(Interval As Long)

#If VBA6 Then

TimerID = SetTimer(0, 0, Interval, AddressOf TimerExecute)

#Else

TimerID = SetTimer(0, 0, Interval, AddrOf("TimerExecute"))

#End If

End Sub

Sub StopTimer()

KillTimer 0, TimerID

End Sub

puis dans un autre module standard, tu vas préparer les procédures dont

tu as besoin pour créer, détruire le timer et lui dire ce qu'il doit

faire. Par exemple :

'====================== > >>
Sub TimerExecute()

'la procédure qui est lancée à chaque déclenchement du timer

If Time > "00:00:00" And Time < "00:15:00" Then

'le code a exécuter entre minuit et minuit 15

End If

End Sub

Sub CreeTimer()

LanceTimer 900000 'déclenchement toutes les 15 minutes

End Sub

Sub FinTimer()

StopTimer

End Sub

'======================= > >>
Dans cet exemple, le timer vérifie l'heure tous les quarts d'heure et,

s'il est entre minuit et minuit et quart, fait ce que tu veux.

Tu peux placer un appel à CreeTimer dans l'événement Workbook_Open de

ton classeur et un appel à FinTimer dans l'événement

Workbook_BeforeClose, ou l'appeler et l'arrêter "à la main" en reliant







Publicité
Poster une réponse
Anonyme