Comment créer un timer sous Excel en VBA qui aille faire une action
périodiquement.
Comment créer un timer sous Excel en VBA qui aille faire une action
périodiquement.
Comment créer un timer sous Excel en VBA qui aille faire une action
périodiquement.
Comment créer un timer sous Excel en VBA qui aille faire une action
périodiquement.
Comment créer un timer sous Excel en VBA qui aille faire une action
périodiquement.
Comment créer un timer sous Excel en VBA qui aille faire une action
périodiquement.
Comment créer un timer sous Excel en VBA qui aille faire une action
périodiquement.
Comment créer un timer sous Excel en VBA qui aille faire une action
périodiquement.
Comment créer un timer sous Excel en VBA qui aille faire une action
périodiquement.
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" a écrit dans le message de news:
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" a écrit dans le message de news:Comment créer un timer sous Excel en VBA qui aille faire une action
périodiquement.
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" <banni@lacurie.va> a écrit dans le message de news:
uS7cLMZFIHA.5544@TK2MSFTNGP02.phx.gbl...
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" <Lolo@discussions.microsoft.com> a écrit dans le message de news:
B50FC790-C918-4BFA-A085-23188BF8B37C@microsoft.com...
Comment créer un timer sous Excel en VBA qui aille faire une action
périodiquement.
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" a écrit dans le message de news:
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" a écrit dans le message de news:Comment créer un timer sous Excel en VBA qui aille faire une action
périodiquement.
surtou "au sortir de la cave"
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" a écrit dans le message de news:
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" a écrit dans le message de news:Comment créer un timer sous Excel en VBA qui aille faire une action
périodiquement.
surtou "au sortir de la cave"
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" <banni@lacurie.va> a écrit dans le message de news:
uS7cLMZFIHA.5544@TK2MSFTNGP02.phx.gbl...
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" <Lolo@discussions.microsoft.com> a écrit dans le message de news:
B50FC790-C918-4BFA-A085-23188BF8B37C@microsoft.com...
Comment créer un timer sous Excel en VBA qui aille faire une action
périodiquement.
surtou "au sortir de la cave"
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" a écrit dans le message de news:
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" a écrit dans le message de news:Comment créer un timer sous Excel en VBA qui aille faire une action
périodiquement.
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" a écrit dans le message de news:
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" a écrit dans le message de news:Comment créer un timer sous Excel en VBA qui aille faire une action
périodiquement.
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" <banni@lacurie.va> a écrit dans le message de news:
uS7cLMZFIHA.5544@TK2MSFTNGP02.phx.gbl...
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" <Lolo@discussions.microsoft.com> a écrit dans le message de news:
B50FC790-C918-4BFA-A085-23188BF8B37C@microsoft.com...
Comment créer un timer sous Excel en VBA qui aille faire une action
périodiquement.
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" a écrit dans le message de news:
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" a écrit dans le message de news:Comment créer un timer sous Excel en VBA qui aille faire une action
périodiquement.
Bonsoir,
il y a essentiel qui a été oublié.....surtou "au sortir de la cave"
Ceci expliquant cela.
;o))
Bonsoir,
il y a essentiel qui a été oublié.....
surtou "au sortir de la cave"
Ceci expliquant cela.
;o))
Bonsoir,
il y a essentiel qui a été oublié.....surtou "au sortir de la cave"
Ceci expliquant cela.
;o))
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!
--
lStephBonsoir,
il y a essentiel qui a été oublié.....surtou "au sortir de la cave"
Ceci expliquant cela.
;o))
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))
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!
--
lStephBonsoir,
il y a essentiel qui a été oublié.....surtou "au sortir de la cave"
Ceci expliquant cela.
;o))
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" a écrit dans le message de news:Comment créer un timer sous Excel en VBA qui aille faire une action
périodiquement.
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" <Lolo@discussions.microsoft.com> a écrit dans le message de news:
B50FC790-C918-4BFA-A085-23188BF8B37C@microsoft.com...
Comment créer un timer sous Excel en VBA qui aille faire une action
périodiquement.
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" a écrit dans le message de news:Comment créer un timer sous Excel en VBA qui aille faire une action
périodiquement.