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" a écrit dans le message de news:Comment créer un timer sous Excel en VBA qui aille faire une action
périodiquement.
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" <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.
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" 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" 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.
Vba232.dll mis à jour disponible à Centre de téléchargement
http://support.microsoft.com/kb/147529/fr
Ce que FS via Msg fonctionne bien. Enregistre ton classeur souvent
car quand ça plante, excel se ferme sur le champ !!!
"Lolo" a écrit dans le message de news:
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" a écrit dans le message de news:Comment créer un timer sous Excel en VBA qui aille faire une action
périodiquement.
Vba232.dll mis à jour disponible à Centre de téléchargement
http://support.microsoft.com/kb/147529/fr
Ce que FS via Msg fonctionne bien. Enregistre ton classeur souvent
car quand ça plante, excel se ferme sur le champ !!!
"Lolo" <Lolo@discussions.microsoft.com> a écrit dans le message de news:
FBCF6220-FBAF-41A5-9EC4-550597E92E3B@microsoft.com...
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" <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.
Vba232.dll mis à jour disponible à Centre de téléchargement
http://support.microsoft.com/kb/147529/fr
Ce que FS via Msg fonctionne bien. Enregistre ton classeur souvent
car quand ça plante, excel se ferme sur le champ !!!
"Lolo" a écrit dans le message de news:
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" a écrit dans le message de news:Comment créer un timer sous Excel en VBA qui aille faire une action
périodiquement.
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" a écrit dans le message de news:Comment créer un timer sous Excel en VBA qui aille faire une action
périodiquement.
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" <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.
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" a écrit dans le message de news:Comment créer un timer sous Excel en VBA qui aille faire une action
périodiquement.
lolo, dis merci à denis qui a beaucoup de mérite de se pencher sur les
bafouillages de ton vénéré Mgr
T.B.
"MichDenis" a écrit dans le message de news:Vba232.dll mis à jour disponible à Centre de téléchargement
http://support.microsoft.com/kb/147529/fr
Ce que FS via Msg fonctionne bien. Enregistre ton classeur souvent
car quand ça plante, excel se ferme sur le champ !!!
"Lolo" a écrit dans le message de news:
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
lolo, dis merci à denis qui a beaucoup de mérite de se pencher sur les
bafouillages de ton vénéré Mgr
T.B.
"MichDenis" <michdenis@hotmail.com> a écrit dans le message de news:
ukqskVjFIHA.5328@TK2MSFTNGP05.phx.gbl...
Vba232.dll mis à jour disponible à Centre de téléchargement
http://support.microsoft.com/kb/147529/fr
Ce que FS via Msg fonctionne bien. Enregistre ton classeur souvent
car quand ça plante, excel se ferme sur le champ !!!
"Lolo" <Lolo@discussions.microsoft.com> a écrit dans le message de news:
FBCF6220-FBAF-41A5-9EC4-550597E92E3B@microsoft.com...
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
lolo, dis merci à denis qui a beaucoup de mérite de se pencher sur les
bafouillages de ton vénéré Mgr
T.B.
"MichDenis" a écrit dans le message de news:Vba232.dll mis à jour disponible à Centre de téléchargement
http://support.microsoft.com/kb/147529/fr
Ce que FS via Msg fonctionne bien. Enregistre ton classeur souvent
car quand ça plante, excel se ferme sur le champ !!!
"Lolo" a écrit dans le message de news:
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