VBATimer

Je viens de trouver dans un fichier de JB cette application :
Application.Wait TimeSerial(Hour(Now()), Minute(Now()), Second(Now()) + 1)

1 ) Comment la modifier si je veux que en même temps tourne une autre macro
ou une portion de macro puisse tourner 3 fois plus vite car il y a 3 fois
plus de résultats possibles.

2 ) Comment faire si j'ai choisi une vitesse 2 que cela aille 2 fois plus
vite?
--
Jean-Paul V


"Jean-Paul V" wrote:

Bonjour à tous

J’ai une barre de défilement allant de 1 à 20 fixant la vitesse .

Comment modifier ma macro afin d’avoir un changement toutes les 3 secondes
avec la vitesse 1 mis dans le range appelé speed?

Pour l’instant j’ai un truc qui marche mais même à la vitesse 1 ça va trop
vite.
Sub Animation_Click()
Dim i As Integer
i = Range("vitesse").Value
Do
' Exécuter la macro avec la vitesse souhaitée de 1 chgt tous les 3 secondes
avec la vitesse 1 mis dans le Range("speed")
Range("Vitesse").Value = i * Range("Speed") * 0.05
Calculate
DoEvents
i = i + 1
....
ma macro
Loop

NB ; j’ai trouvé dans Excelabo cette macro mais je ne comprends rien :
'Attribute VB_Name = "VBATimer"
Option Explicit

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

Dim TimerID As Long

Sub TimerOff()
KillTimer 0, TimerID
MsgBox "Le timer a été détruit"
End Sub

Sub TimerOn(Interval As Long)
TimerID = SetTimer(0, 0, Interval, AddressOf TimerProc)
End Sub

Sub TimerProc()
MsgBox "Exécution du code"
End Sub


Sub test()
TimerOn 5000
MsgBox "Création du timer"
Application.OnTime Now + TimeValue("00:00:30"), "TimerOff"
End Sub

@+ j’espère

--
Jean-Paul V

Bonjour, puisqu'a priori les API fonctionnent dans le VBA, voici une routine
de principe:

------entête---
Private Declare Function GetTickCount Lib "Kernel32" () As Long

' Cette API compte en ms le temps écoulé depuis la mise sous tension.
dim Tpresent as long
dim Tfutur as long

sub nomProcedure()
Tpresent = 0
Tfutur = GetTickCount() + 3000
Do While Tpresent < Tfutur
Tpresent = GetTickCount()
loop
end sub

--
Romans, logiciels, email, site personnel
http://irolog.free.fr/joe.htm
------------------------------------------------------------------------------------
"Jean-Paul V" <JeanPaulV@discussions.microsoft.com> a écrit dans le message
de news: F5C44033-42C9-4F4E-9503-61DE3038BD18@microsoft.com...
| Bonjour à tous
|
| J'ai une barre de défilement allant de 1 à 20 fixant la vitesse .
|
| Comment modifier ma macro afin d'avoir un changement toutes les 3 secondes
| avec la vitesse 1 mis dans le range appelé speed?
|
| Pour l'instant j'ai un truc qui marche mais même à la vitesse 1 ça va trop
| vite.
| Sub Animation_Click()
| Dim i As Integer
| i = Range("vitesse").Value
| Do
| ' Exécuter la macro avec la vitesse souhaitée de 1 chgt tous les 3
secondes
| avec la vitesse 1 mis dans le Range("speed")
| Range("Vitesse").Value = i * Range("Speed") * 0.05
| Calculate
| DoEvents
| i = i + 1
| ....
| ma macro
| Loop
|
| NB ; j'ai trouvé dans Excelabo cette macro mais je ne comprends rien :
| 'Attribute VB_Name = "VBATimer"
| Option Explicit
|
| 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
|
| Dim TimerID As Long
|
| Sub TimerOff()
| KillTimer 0, TimerID
| MsgBox "Le timer a été détruit"
| End Sub
|
| Sub TimerOn(Interval As Long)
| TimerID = SetTimer(0, 0, Interval, AddressOf TimerProc)
| End Sub
|
| Sub TimerProc()
| MsgBox "Exécution du code"
| End Sub
|
|
| Sub test()
| TimerOn 5000
| MsgBox "Création du timer"
| Application.OnTime Now + TimeValue("00:00:30"), "TimerOff"
| End Sub
|
| @+ j'espère
|
| --
| Jean-Paul V

Bonjour, re,

Tiens, voici le code de l'exemple Windows pour les Timer par API, à mon
avis, laisse tomber ça si tu n'as jamais fait d'API ni de fonctions, car
celle-là n'est pas simple:

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

4. Copiez le code suivant à la fenêtre Code de Module1 :
Option Explicit

Declare Function SetTimer Lib "user32" _
(ByVal hwnd As Long, _
ByVal nIDEvent As Long, _
ByVal uElapse As Long, _
ByVal lpTimerFunc As Long) As Long

Declare Function KillTimer Lib "user32" _
(ByVal hwnd As Long, _
ByVal nIDEvent As Long) As Long

Global iCounter As Integer

Sub TimerProc(ByVal hwnd As Long, _
ByVal uMsg As Long, _
ByVal idEvent As Long, _
ByVal dwTime As Long)

iCounter = iCounter + 1
Form1.Text1.Text = CStr(iCounter)
End Sub



5. Copiez le code suivant à la fenêtre Code de Form1 : Option Explicit
Dim lngTimerID As Long
Dim BlnTimer As Boolean

Private Sub Form_Load()
BlnTimer = False
Command1.Caption = "Start Timer"
End Sub

Private Sub Command1_Click()
'Starts and stops the timer.

If BlnTimer = False Then
lngTimerID = SetTimer(0, 0, 200, AddressOf TimerProc)
If lngTimerID = 0 Then
MsgBox "Timer not created. Ending Program"
Exit Sub
End If
BlnTimer = True
Command1.Caption = "Stop Timer"
Else
lngTimerID = KillTimer(0, lngTimerID)
If lngTimerID = 0 Then
MsgBox "couldn't kill the timer"
End If
BlnTimer = False
Command1.Caption = "Start Timer"
End If
End Sub

--
Romans, logiciels, email, site personnel
http://irolog.free.fr/joe.htm
------------------------------------------------------------------------------------
"Jean-Paul V" <JeanPaulV@discussions.microsoft.com> a écrit dans le message
de news: F5C44033-42C9-4F4E-9503-61DE3038BD18@microsoft.com...
| Bonjour à tous
|
| J'ai une barre de défilement allant de 1 à 20 fixant la vitesse .
|
| Comment modifier ma macro afin d'avoir un changement toutes les 3 secondes
| avec la vitesse 1 mis dans le range appelé speed?
|
| Pour l'instant j'ai un truc qui marche mais même à la vitesse 1 ça va trop
| vite.
| Sub Animation_Click()
| Dim i As Integer
| i = Range("vitesse").Value
| Do
| ' Exécuter la macro avec la vitesse souhaitée de 1 chgt tous les 3
secondes
| avec la vitesse 1 mis dans le Range("speed")
| Range("Vitesse").Value = i * Range("Speed") * 0.05
| Calculate
| DoEvents
| i = i + 1
| ....
| ma macro
| Loop
|
| NB ; j'ai trouvé dans Excelabo cette macro mais je ne comprends rien :
| 'Attribute VB_Name = "VBATimer"
| Option Explicit
|
| 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
|
| Dim TimerID As Long
|
| Sub TimerOff()
| KillTimer 0, TimerID
| MsgBox "Le timer a été détruit"
| End Sub
|
| Sub TimerOn(Interval As Long)
| TimerID = SetTimer(0, 0, Interval, AddressOf TimerProc)
| End Sub
|
| Sub TimerProc()
| MsgBox "Exécution du code"
| End Sub
|
|
| Sub test()
| TimerOn 5000
| MsgBox "Création du timer"
| Application.OnTime Now + TimeValue("00:00:30"), "TimerOff"
| End Sub
|
| @+ j'espère
|
| --
| Jean-Paul V

On Wed, 13 Aug 2008 06:36:11 -0700, Jean-Paul V
<JeanPaulV@discussions.microsoft.com> wrote:

'Attribute VB_Name = "VBATimer"
Option Explicit

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

Dim TimerID As Long

Sub TimerOff()
KillTimer 0, TimerID
MsgBox "Le timer a été détruit"
End Sub

Sub TimerOn(Interval As Long)
TimerID = SetTimer(0, 0, Interval, AddressOf TimerProc)
End Sub

Sub TimerProc()
MsgBox "Exécution du code"
End Sub

Tu copies ce qui précède dans un module.

Tu initialise un timer avec un intervalle de 3s :
TimerOn 3000 (L'API SetTimer crée un timer et retourne un id qui est
conservé dans la variable TimerID - utile pour détruire ensuite ce
timer).

Quand le timer se déclenche il exécute la procédure TimerProc (la
fonction publique dont l'adresse est transmise au timer avec AddressOf
par l'API SetTimer). Donc tu mettre un appel au code que tu veux
exécuter dans TimerProc.

Pour arrêter le timer, il faut faire un appel à TimerOff (qui fait un
appel à l'API KillTimer avec l'id du timer crée précédemment).
C'est important de détruire tout timer existant avant d'en créer un
nouveau ou de quitter Excel.

Sub test()
TimerOn 5000
MsgBox "Création du timer"
Application.OnTime Now + TimeValue("00:00:30"), "TimerOff"
End Sub

Qunad tu exécute cette procédure, elle crée un timer avec un
intervalle de 5s. Toutes les 5s, le timer déclenche TimerProc est donc
affiche un msgbox. Au bout de 30s, l'application détruit le timer avec
un appel à TimerOff.

Bonjour

Merci bien pour tous ces renseignements
--
Jean-Paul V


"LE TROLL" wrote:

Bonjour, re,

Tiens, voici le code de l'exemple Windows pour les Timer par API, à mon
avis, laisse tomber ça si tu n'as jamais fait d'API ni de fonctions, car
celle-là n'est pas simple:

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

4. Copiez le code suivant à la fenêtre Code de Module1 :
Option Explicit

Declare Function SetTimer Lib "user32" _
(ByVal hwnd As Long, _
ByVal nIDEvent As Long, _
ByVal uElapse As Long, _
ByVal lpTimerFunc As Long) As Long

Declare Function KillTimer Lib "user32" _
(ByVal hwnd As Long, _
ByVal nIDEvent As Long) As Long

Global iCounter As Integer

Sub TimerProc(ByVal hwnd As Long, _
ByVal uMsg As Long, _
ByVal idEvent As Long, _
ByVal dwTime As Long)

iCounter = iCounter + 1
Form1.Text1.Text = CStr(iCounter)
End Sub



5. Copiez le code suivant à la fenêtre Code de Form1 : Option Explicit
Dim lngTimerID As Long
Dim BlnTimer As Boolean

Private Sub Form_Load()
BlnTimer = False
Command1.Caption = "Start Timer"
End Sub

Private Sub Command1_Click()
'Starts and stops the timer.

If BlnTimer = False Then
lngTimerID = SetTimer(0, 0, 200, AddressOf TimerProc)
If lngTimerID = 0 Then
MsgBox "Timer not created. Ending Program"
Exit Sub
End If
BlnTimer = True
Command1.Caption = "Stop Timer"
Else
lngTimerID = KillTimer(0, lngTimerID)
If lngTimerID = 0 Then
MsgBox "couldn't kill the timer"
End If
BlnTimer = False
Command1.Caption = "Start Timer"
End If
End Sub

--
Romans, logiciels, email, site personnel
http://irolog.free.fr/joe.htm
------------------------------------------------------------------------------------
"Jean-Paul V" <JeanPaulV@discussions.microsoft.com> a écrit dans le message
de news: F5C44033-42C9-4F4E-9503-61DE3038BD18@microsoft.com...
| Bonjour à tous
|
| J'ai une barre de défilement allant de 1 à 20 fixant la vitesse .
|
| Comment modifier ma macro afin d'avoir un changement toutes les 3 secondes
| avec la vitesse 1 mis dans le range appelé speed?
|
| Pour l'instant j'ai un truc qui marche mais même à la vitesse 1 ça va trop
| vite.
| Sub Animation_Click()
| Dim i As Integer
| i = Range("vitesse").Value
| Do
| ' Exécuter la macro avec la vitesse souhaitée de 1 chgt tous les 3
secondes
| avec la vitesse 1 mis dans le Range("speed")
| Range("Vitesse").Value = i * Range("Speed") * 0.05
| Calculate
| DoEvents
| i = i + 1
| ....
| ma macro
| Loop
|
| NB ; j'ai trouvé dans Excelabo cette macro mais je ne comprends rien :
| 'Attribute VB_Name = "VBATimer"
| Option Explicit
|
| 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
|
| Dim TimerID As Long
|
| Sub TimerOff()
| KillTimer 0, TimerID
| MsgBox "Le timer a été détruit"
| End Sub
|
| Sub TimerOn(Interval As Long)
| TimerID = SetTimer(0, 0, Interval, AddressOf TimerProc)
| End Sub
|
| Sub TimerProc()
| MsgBox "Exécution du code"
| End Sub
|
|
| Sub test()
| TimerOn 5000
| MsgBox "Création du timer"
| Application.OnTime Now + TimeValue("00:00:30"), "TimerOff"
| End Sub
|
| @+ j'espère
|
| --
| Jean-Paul V

Merci c'est plus clair maintenant
--
Jean-Paul V


"parci" wrote:

On Wed, 13 Aug 2008 06:36:11 -0700, Jean-Paul V
<JeanPaulV@discussions.microsoft.com> wrote:

>'Attribute VB_Name = "VBATimer"
>Option Explicit
>
>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
>
>Dim TimerID As Long
>
>Sub TimerOff()
> KillTimer 0, TimerID
> MsgBox "Le timer a été détruit"
>End Sub
>
>Sub TimerOn(Interval As Long)
> TimerID = SetTimer(0, 0, Interval, AddressOf TimerProc)
>End Sub
>
>Sub TimerProc()
> MsgBox "Exécution du code"
>End Sub

Tu copies ce qui précède dans un module.

Tu initialise un timer avec un intervalle de 3s :
TimerOn 3000 (L'API SetTimer crée un timer et retourne un id qui est
conservé dans la variable TimerID - utile pour détruire ensuite ce
timer).

Quand le timer se déclenche il exécute la procédure TimerProc (la
fonction publique dont l'adresse est transmise au timer avec AddressOf
par l'API SetTimer). Donc tu mettre un appel au code que tu veux
exécuter dans TimerProc.

Pour arrêter le timer, il faut faire un appel à TimerOff (qui fait un
appel à l'API KillTimer avec l'id du timer crée précédemment).
C'est important de détruire tout timer existant avant d'en créer un
nouveau ou de quitter Excel.

>
>Sub test()
> TimerOn 5000
> MsgBox "Création du timer"
> Application.OnTime Now + TimeValue("00:00:30"), "TimerOff"
>End Sub

Qunad tu exécute cette procédure, elle crée un timer avec un
intervalle de 5s. Toutes les 5s, le timer déclenche TimerProc est donc
affiche un msgbox. Au bout de 30s, l'application détruit le timer avec
un appel à TimerOff.