Le temps qui passe

patrick.lyon

23/10/2003 à 16:36

"Pierre Dumas" avait soumis l'idée :

j'avais fait un truc un peu du même style
tu choisissais quelle table tu voulais
tu cliquais sur go
et tu avais 15 réponses a donner tirée aléatoirement
tu cliquais sur stop
et tu avais ton temps
et les résultats

--
Ceci est une signature automatique de MesNews.
Site : http://mesnews.no-ip.com

"Pierre Dumas" avait soumis l'idée :

j'avais fait un truc un peu du même style
tu choisissais quelle table tu voulais
tu cliquais sur go
et tu avais 15 réponses a donner tirée aléatoirement
tu cliquais sur stop
et tu avais ton temps
et les résultats

--
Ceci est une signature automatique de MesNews.
Site : http://mesnews.no-ip.com

Vous avez filtré cet utilisateur ! Consultez son message

"Pierre Dumas" avait soumis l'idée :

j'avais fait un truc un peu du même style
tu choisissais quelle table tu voulais
tu cliquais sur go
et tu avais 15 réponses a donner tirée aléatoirement
tu cliquais sur stop
et tu avais ton temps
et les résultats

--
Ceci est une signature automatique de MesNews.
Site : http://mesnews.no-ip.com

Hervé

23/10/2003 à 21:05

Salut Pierre,
J'ai modifié ton code. Adapte si cela ne te convient pas :

Declare Function GetTickCount Lib "Kernel32" () As Long

Sub LesDonnees()
Dim ValeurMax As Integer
Dim ValeurMin As Integer
Randomize
ValeurMax = 11
ValeurMin = 0
Application.EnableEvents = False
[A1:b3] = ""
[A1] = Int(Rnd() * (ValeurMax - ValeurMin) + 1)
[A2] = Int(Rnd() * (ValeurMax - ValeurMin) + 1)
Application.EnableEvents = True
LeChrono
End Sub

Sub Minuterie(Milliseconde As Long)
Dim Arret As Long
Arret = GetTickCount() + Milliseconde
Do While GetTickCount() < Arret
'à supprimer si tu ne veux pas voir le décompte en B1
[B1] = Format((Arret - GetTickCount()) / 1000, "00:00:00")
DoEvents
Loop
End Sub

Private Sub LeChrono()
Minuterie 5000
If Range("A1") * Range("A2") <> Range("A3") Or IsEmpty _
(Range("A3")) = True Then
MsgBox "Tu n'es pas encore Lucky Luke"
End If
End Sub

Hervé.

"Pierre Dumas" a écrit dans le message
news: 0b4801c39972$3eeb10e0$

Salut Pierre,
J'ai modifié ton code. Adapte si cela ne te convient pas :

Declare Function GetTickCount Lib "Kernel32" () As Long

Sub LesDonnees()
Dim ValeurMax As Integer
Dim ValeurMin As Integer
Randomize
ValeurMax = 11
ValeurMin = 0
Application.EnableEvents = False
[A1:b3] = ""
[A1] = Int(Rnd() * (ValeurMax - ValeurMin) + 1)
[A2] = Int(Rnd() * (ValeurMax - ValeurMin) + 1)
Application.EnableEvents = True
LeChrono
End Sub

Sub Minuterie(Milliseconde As Long)
Dim Arret As Long
Arret = GetTickCount() + Milliseconde
Do While GetTickCount() < Arret
'à supprimer si tu ne veux pas voir le décompte en B1
[B1] = Format((Arret - GetTickCount()) / 1000, "00:00:00")
DoEvents
Loop
End Sub

Private Sub LeChrono()
Minuterie 5000
If Range("A1") * Range("A2") <> Range("A3") Or IsEmpty _
(Range("A3")) = True Then
MsgBox "Tu n'es pas encore Lucky Luke"
End If
End Sub

Hervé.

"Pierre Dumas" <anonymous@discussions.microsoft.com> a écrit dans le message
news: 0b4801c39972$3eeb10e0$a501280a@phx.gbl...

Vous avez filtré cet utilisateur ! Consultez son message

Salut Pierre,
J'ai modifié ton code. Adapte si cela ne te convient pas :

Declare Function GetTickCount Lib "Kernel32" () As Long

Sub LesDonnees()
Dim ValeurMax As Integer
Dim ValeurMin As Integer
Randomize
ValeurMax = 11
ValeurMin = 0
Application.EnableEvents = False
[A1:b3] = ""
[A1] = Int(Rnd() * (ValeurMax - ValeurMin) + 1)
[A2] = Int(Rnd() * (ValeurMax - ValeurMin) + 1)
Application.EnableEvents = True
LeChrono
End Sub

Sub Minuterie(Milliseconde As Long)
Dim Arret As Long
Arret = GetTickCount() + Milliseconde
Do While GetTickCount() < Arret
'à supprimer si tu ne veux pas voir le décompte en B1
[B1] = Format((Arret - GetTickCount()) / 1000, "00:00:00")
DoEvents
Loop
End Sub

Private Sub LeChrono()
Minuterie 5000
If Range("A1") * Range("A2") <> Range("A3") Or IsEmpty _
(Range("A3")) = True Then
MsgBox "Tu n'es pas encore Lucky Luke"
End If
End Sub

Hervé.

"Pierre Dumas" a écrit dans le message
news: 0b4801c39972$3eeb10e0$

Pierre Dumas

24/10/2003 à 09:43

Bonjour

Cela a l'air de fonctionner parfaitement, SAUF si on
commence la saisie dans la cellule.
Alors le chrono s'arrete et l'on a tout le temps de
reflechir pour taper son resultat.
On peut meme commencer la saisie, faire Echap et compter
sur ses doigts avant de saisir le resultat...

Existe-t'il un autre moyen pour que le chrono continue,
meme si on a commence la saisie ?

merci deja pour l'aide apportee.

Pierre

Alain CROS

24/10/2003 à 14:08

Bonjour.

Essaye comme ça.

Dans ton Module.

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 LesDonnees()
Dim ValeurMax As Integer
Dim ValeurMin As Integer

ValeurMax = 11
ValeurMin = 0
Application.EnableEvents = False
Range("A3:B3").Select
Selection = Empty

Range("A1:A2").Select
Selection.FormulaR1C1 = _
"=int(rand()*(" & ValeurMax & " -" & ValeurMin & ")+" & ValeurMin & ")"
Selection.Copy
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:úlse
Application.CutCopyMode = False
Range("A3").Select
LanceTimer (5000)
Application.EnableEvents = True
End Sub

Sub LanceTimer(Interval As Long)
#If VBA6 Then
TimerID = SetTimer(0, 0, Interval, AddressOf LeChrono)
#Else
TimerID = SetTimer(0, 0, Interval, AddrOf("LeChrono"))
#End If
End Sub
Sub StopTimer()
KillTimer 0, TimerID
End Sub
Sub LeChrono()
StopTimer
If Range("A1") * Range("A2") <> Range("A3") Or IsEmpty(Range("A3")) = True
Then
MsgBox "Tu n'es pas encore Lucky Luke"
End If
End Sub

Si tu travaille sur XL97, tu rajoute 1 module et tu colle ça dedans.

Option Explicit

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
#If VBA6 Then
#Else
Public 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

Alain CROS.

----- Original Message -----
From: "Pierre Dumas"
Newsgroups: microsoft.public.fr.excel
Sent: Friday, October 24, 2003 9:43 AM
Subject: Re: Le temps qui passe

Bonjour

Cela a l'air de fonctionner parfaitement, SAUF si on
commence la saisie dans la cellule.
Alors le chrono s'arrete et l'on a tout le temps de
reflechir pour taper son resultat.
On peut meme commencer la saisie, faire Echap et compter
sur ses doigts avant de saisir le resultat...

Existe-t'il un autre moyen pour que le chrono continue,
meme si on a commence la saisie ?

merci deja pour l'aide apportee.

Pierre

Bonjour.

Essaye comme ça.

Dans ton Module.

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 LesDonnees()
Dim ValeurMax As Integer
Dim ValeurMin As Integer

ValeurMax = 11
ValeurMin = 0
Application.EnableEvents = False
Range("A3:B3").Select
Selection = Empty

Range("A1:A2").Select
Selection.FormulaR1C1 = _
"=int(rand()*(" & ValeurMax & " -" & ValeurMin & ")+" & ValeurMin & ")"
Selection.Copy
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:úlse
Application.CutCopyMode = False
Range("A3").Select
LanceTimer (5000)
Application.EnableEvents = True
End Sub

Sub LanceTimer(Interval As Long)
#If VBA6 Then
TimerID = SetTimer(0, 0, Interval, AddressOf LeChrono)
#Else
TimerID = SetTimer(0, 0, Interval, AddrOf("LeChrono"))
#End If
End Sub
Sub StopTimer()
KillTimer 0, TimerID
End Sub
Sub LeChrono()
StopTimer
If Range("A1") * Range("A2") <> Range("A3") Or IsEmpty(Range("A3")) = True
Then
MsgBox "Tu n'es pas encore Lucky Luke"
End If
End Sub

Si tu travaille sur XL97, tu rajoute 1 module et tu colle ça dedans.

Option Explicit

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
#If VBA6 Then
#Else
Public 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

Alain CROS.

----- Original Message -----
From: "Pierre Dumas" <anonymous@discussions.microsoft.com>
Newsgroups: microsoft.public.fr.excel
Sent: Friday, October 24, 2003 9:43 AM
Subject: Re: Le temps qui passe

Bonjour

Cela a l'air de fonctionner parfaitement, SAUF si on
commence la saisie dans la cellule.
Alors le chrono s'arrete et l'on a tout le temps de
reflechir pour taper son resultat.
On peut meme commencer la saisie, faire Echap et compter
sur ses doigts avant de saisir le resultat...

Existe-t'il un autre moyen pour que le chrono continue,
meme si on a commence la saisie ?

merci deja pour l'aide apportee.

Pierre

Vous avez filtré cet utilisateur ! Consultez son message

Bonjour.

Essaye comme ça.

Dans ton Module.

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 LesDonnees()
Dim ValeurMax As Integer
Dim ValeurMin As Integer

ValeurMax = 11
ValeurMin = 0
Application.EnableEvents = False
Range("A3:B3").Select
Selection = Empty

Range("A1:A2").Select
Selection.FormulaR1C1 = _
"=int(rand()*(" & ValeurMax & " -" & ValeurMin & ")+" & ValeurMin & ")"
Selection.Copy
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:úlse
Application.CutCopyMode = False
Range("A3").Select
LanceTimer (5000)
Application.EnableEvents = True
End Sub

Sub LanceTimer(Interval As Long)
#If VBA6 Then
TimerID = SetTimer(0, 0, Interval, AddressOf LeChrono)
#Else
TimerID = SetTimer(0, 0, Interval, AddrOf("LeChrono"))
#End If
End Sub
Sub StopTimer()
KillTimer 0, TimerID
End Sub
Sub LeChrono()
StopTimer
If Range("A1") * Range("A2") <> Range("A3") Or IsEmpty(Range("A3")) = True
Then
MsgBox "Tu n'es pas encore Lucky Luke"
End If
End Sub

Si tu travaille sur XL97, tu rajoute 1 module et tu colle ça dedans.

Option Explicit

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
#If VBA6 Then
#Else
Public 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

Alain CROS.

----- Original Message -----
From: "Pierre Dumas"
Newsgroups: microsoft.public.fr.excel
Sent: Friday, October 24, 2003 9:43 AM
Subject: Re: Le temps qui passe

Bonjour

Cela a l'air de fonctionner parfaitement, SAUF si on
commence la saisie dans la cellule.
Alors le chrono s'arrete et l'on a tout le temps de
reflechir pour taper son resultat.
On peut meme commencer la saisie, faire Echap et compter
sur ses doigts avant de saisir le resultat...

Existe-t'il un autre moyen pour que le chrono continue,
meme si on a commence la saisie ?

merci deja pour l'aide apportee.

Pierre

Frédéric Sigonneau

24/10/2003 à 14:54

Bonjour,

A ma connaissance, non. En mode édition, Excel passe en monotâche (si ce terme
existe) et bloque toutes ses autres tâches en cours jusqu'à ce que tu en sois
sorti..
Par ailleurs, VBA n'est pas multithread, tu ne peux pas lancer un timer dans un
espace mémoire réservé et indépendant de celui d'Excel, donc, même punition, le
mode édition bloque aussi ton chrono...
Pas d'issue, AMA :(

FS
--
Frédéric Sigonneau [MVP Excel - né un sans-culottide]
Gestions de temps, VBA pour Excel :
http://perso.wanadoo.fr/frederic.sigonneau
Si votre question sur Excel est urgente, évitez ma bal !

patrick.lyon

24/10/2003 à 16:35

re
et en récupérant l'heure systeme en début et fin de macro ???

Le 24/10/2003, "Frédéric Sigonneau" a supposé :

--
Ceci est une signature automatique de MesNews.
Site : http://mesnews.no-ip.com

Pierre Dumas

24/10/2003 à 16:38

Nickel Angel ;-)

Y'a plus qu'a tester en 97.

Merci encore.

Pierre

Frédéric Sigonneau

24/10/2003 à 17:33

Bonjour,

Ça te permet de mesurer le temps d'exécution de ta macro mais guère plus, AMA..
On peut créer des timers avec VBA (y compris directement des timers Windows,
voir le code posté par Alain Cros) mais, selon mon expérience, leur utilisation
n'est pas fiable. Excel finit toujours, et assez rapidement, par s'emmêler les
crayons et planter.
J'ai de ce fait complètement renoncé à toute temporisation avec Excel (même si
je propose des solutions à base de timers sur mon site), mais je ne demande pas
mieux que de changer d'avis :)

FS
--
Frédéric Sigonneau [MVP Excel - né un sans-culottide]
Gestions de temps, VBA pour Excel :
http://perso.wanadoo.fr/frederic.sigonneau
Si votre question sur Excel est urgente, évitez ma bal !

Clément Marcotte

25/10/2003 à 02:13

Bonjour,

Une solution à la précision quelque peu incertaine:

Un boucle vide:

for i = 1 to 10000
next

PS. Je ne serais pas surpris que ce soit plus que 10000, et le nombre
doit un peu beaucoup dépendre des performances de la machine.

"Pierre Dumas" a écrit dans le
message de news:0b4801c39972$3eeb10e0$

Bonjour,

Une solution à la précision quelque peu incertaine:

Un boucle vide:

for i = 1 to 10000
next

PS. Je ne serais pas surpris que ce soit plus que 10000, et le nombre
doit un peu beaucoup dépendre des performances de la machine.

"Pierre Dumas" <anonymous@discussions.microsoft.com> a écrit dans le
message de news:0b4801c39972$3eeb10e0$a501280a@phx.gbl...

Vous avez filtré cet utilisateur ! Consultez son message

Bonjour,

Une solution à la précision quelque peu incertaine:

Un boucle vide:

for i = 1 to 10000
next

PS. Je ne serais pas surpris que ce soit plus que 10000, et le nombre
doit un peu beaucoup dépendre des performances de la machine.

"Pierre Dumas" a écrit dans le
message de news:0b4801c39972$3eeb10e0$

Le temps qui passe

9 réponses

Veuillez sélectionner un problème