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.
Vidéos High-Tech et Jeu Vidéo
Téléchargements
Vos réponses Page 1 / 2
Gagnez chaque mois un abonnement Premium avec GNT : Inscrivez-vous !
Trier par : date / pertinence
Mgr Banni
Le #4999381
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 #4999351
Mgr devrait soigner son français !!!

salue prend un S , écoutez monseigneur nous somme plusieurs

surtou ne fait pas encore parti du dictionnaire, vous vous décider : sur tout ou surtout ???

Comment je vais moi pour parfaire mon français si je lis n'importe quoi
provenant d'éminence, hein ???

;-)))

à un autre niveau, tu aurais pu lui conseiller de regarder ceci :

Application.OnTime voir l'aide sur la méthode "OnTime"




"Mgr Banni"
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 #4999301
n'ai-je pas dit que j'étais gris (surtout à cette heure...ou à 7 heures du
soir)?
allez vite vous confesser, garnement, pour avoir osé critiquer votre guide
spirituel...ou, pour le moins, en spiritueux
Mgr T.B.

"MichDenis"
Mgr devrait soigner son français !!!

salue prend un S , écoutez monseigneur nous somme plusieurs

surtou ne fait pas encore parti du dictionnaire, vous vous décider : sur
tout ou surtout ???

Comment je vais moi pour parfaire mon français si je lis n'importe quoi
provenant d'éminence, hein ???

;-)))

à un autre niveau, tu aurais pu lui conseiller de regarder ceci :

Application.OnTime voir l'aide sur la méthode "OnTime"




"Mgr Banni"
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.






Jacky
Le #4999291
Bonsoir,

il y a essentiel qui a été oublié.....
surtou "au sortir de la cave"


Ceci expliquant cela.
;o))
--
Salutations
JJ


"MichDenis"
Mgr devrait soigner son français !!!

salue prend un S , écoutez monseigneur nous somme plusieurs

surtou ne fait pas encore parti du dictionnaire, vous vous décider : sur
tout ou surtout ???

Comment je vais moi pour parfaire mon français si je lis n'importe quoi
provenant d'éminence, hein ???

;-)))

à un autre niveau, tu aurais pu lui conseiller de regarder ceci :

Application.OnTime voir l'aide sur la méthode "OnTime"




"Mgr Banni"
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 #4999261
Toutes mes excuses éminence, il m'arrive d'oublier le décalage horaire !!!

;-)

"Mgr Banni" %
n'ai-je pas dit que j'étais gris (surtout à cette heure...ou à 7 heures du
soir)?
allez vite vous confesser, garnement, pour avoir osé critiquer votre guide
spirituel...ou, pour le moins, en spiritueux
Mgr T.B.

"MichDenis"
Mgr devrait soigner son français !!!

salue prend un S , écoutez monseigneur nous somme plusieurs

surtou ne fait pas encore parti du dictionnaire, vous vous décider : sur
tout ou surtout ???

Comment je vais moi pour parfaire mon français si je lis n'importe quoi
provenant d'éminence, hein ???

;-)))

à un autre niveau, tu aurais pu lui conseiller de regarder ceci :

Application.OnTime voir l'aide sur la méthode "OnTime"




"Mgr Banni"
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 #4999231
J'aimerais porter à l'attention de Mgr ceci :

EAU ou VIN
Après plusieurs expériences soigneusement contrôlées en laboratoire, des
scientifiques ont découvert que si nous buvions 1 litre d'eau chaque jour, à
la fin de l'année nous aurions absorbé plus de 1 kilo de bactéries
d'Escherichia coli, (E. Coli) trouvées dans les excréments.

Autrement dit, nous consommerions 1 kilo de merde.
Cependant, nous ne courons pas ce risque en buvant du vin parce que l'alcool
doit passer par un processus de purification, filtrage et/ou fermentation.

Souvenez-vous : Eau = Merde Vin = Santé

Donc, il est meilleur de boire du vin et avoir une conversation stupide, que
boire de l'eau et être plein de marde.

Il n'y a aucun besoin de me remercier pour ces informations de valeur.
LSteph
Le #4999031
Bonsoir Jacky,

;-)
toi aussi tu dois réviser ta grammaire
avec Mgr comme sujet seul le verbe "entrer dans la cave"
s'emploie au présent, le verbe sortir est soit au futur,
soit bien sûr à la voie passive!

--
lSteph




Bonsoir,

il y a essentiel qui a été oublié.....
surtou "au sortir de la cave"


Ceci expliquant cela.
;o))



Jacky
Le #4998921
;o))

Moi j'ai loupé le " L' "
Faut dire, d'après ce que j'ai lu hier, il a reçu un savon de son supérieur
hiérarchique, du coup son éminence s'est enfermé dans sa cave.....à vin bien
sur.

--

Salutations
JJ


"LSteph" %
Bonsoir Jacky,

;-)
toi aussi tu dois réviser ta grammaire
avec Mgr comme sujet seul le verbe "entrer dans la cave"
s'emploie au présent, le verbe sortir est soit au futur,
soit bien sûr à la voie passive!

--
lSteph




Bonsoir,

il y a essentiel qui a été oublié.....
surtou "au sortir de la cave"


Ceci expliquant cela.
;o))





Lolo
Le #4998501
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.






Publicité
Poster une réponse
Anonyme