Chronomètre dans un UserForm

Version imprimable

Bonjour,
Je suis entraineur de basket et j'utilise une feuille Excel avec une boîte de dialogue pour faire des tests physique a mes joueuses.
Je lance la boite de dialogue depuis un bouton dans la feuille où sont enregistré les données.
J'ai un bouton (CommandButton1) qui me permet de lancer le test et d'afficher un chrono.
En plus du chrono, une Zone de texte pour chaque joueuse avec un Bouton associé. Ce bouton me permet d'aller écrire le résultat du test (c'est l'heure à laquelle il prend fin) dans la feuille Excel.
C'est la façon dont j'ai codé le chrono qui pose un problème.
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 Private Sub CommandButton1_Click() Range("E2:E25").Select Selection.ClearContents Arrêt = False temps = TimeValue("00:00:00") UpdateChrono End Sub Private Sub UpdateChrono() If Not Arrêt Then Application.OnTime Now + TimeValue("00:00:01"), "UserForm1.UpdateChrono" temps = DateAdd("s", 1, temps) Me.TextBox25 = Format(temps, "hh:mm:ss") End If End Sub
La boucle If/End If ne fonctionne qu'une fois et mon chrono s'incrémente jusqu'à 00:00:01 avant que le message "Impossible d'éxécuter la macro UpdateChrono" ne s'affiche.
Merci d'avance pour votre aide.

If/End If n'est pas une boucle, c'est un test simple
les boucles sont For , While, Until
Dans ton cas, le While, avec lajout d'un DoEvents pour ne pas avoir une boucle infinie
Code:

1 2 3 4 5 6 7 8 Private Sub UpdateChrono() While( Not Arrêt) Application.OnTime Now + TimeValue("00:00:01"), "UserForm1.UpdateChrono" temps = DateAdd("s", 1, temps) Me.TextBox25 = Format(temps, "hh:mm:ss") Application.DoEvents Wend End Sub

04/07/2023, 13h49
puledro

Merci pour ta réponse.
J'ai fait la modification et il m'a dit qu'il y a une erreur de syntaxe en surlignant le End while.
J'ai modifié la boucle en utilisant While / Wend.
Le chrono mètre compte "00:00:01" mais j'obtiens le message suivant sur Application.DoEvents /
Erreur d'exécution '438'
Propriété ou méthode non gérée par cet objet.
04/07/2023, 14h12
deedolith
Il y a une erreur de syntaxe, la boucle While c'est:
Code:

1 2 While (condition) Wend
PS: tu aurais dû t'en rendre compte, c'est la base de chez basique.
04/07/2023, 14h21
umfred
Citation:
Envoyé par deedolith

Il y a une erreur de syntaxe, la boucle While c'est:

Code:

1 2 While (condition) Wend

PS: tu aurais dû t'en rendre compte, c'est la base de chez basique.
pas faux, mais je me suis mélangé les pinceaux :roll:
j'étais parti sur un While .. Loop mais dans ce cas, ça aurait été Do While .. Loop et j'ai corrigé trop rapidement

Hello,
en fait il faut mettre les procédures dans un module et pas dans le code du formulaire. Il faut aussi dans le module déclarer les variables globales.

Code du formulaire :

Code:

1
2
3
4
5
6
7
8
Private Sub CommandButton1_Click()
    StartChrono
    UpdateChrono
End Sub
 
Private Sub CommandButton2_Click()
    StopChrono
End Sub

Code du Module :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
Dim Arrêt As Boolean
Dim temps
Sub UpdateChrono()
    If Not Arrêt Then
        UserForm1.Label1 = Format(temps, "hh:mm:ss")
        Application.OnTime Now + TimeValue("00:00:01"), "UpdateChrono"
        temps = DateAdd("s", 1, temps)
    End If
End Sub
 
Sub StartChrono()
     Arrêt = False
     temps = TimeValue("00:00:00")
End Sub
 
Sub StopChrono()
     Arrêt = True
End Sub

et il ne faut pas utiliser de boucle :mouarf:

Ami calmant, J.P

04/07/2023, 14h27
umfred

Citation:

Envoyé par puledro

Merci pour ta réponse.
J'ai fait la modification et il m'a dit qu'il y a une erreur de syntaxe en surlignant le End while.
J'ai modifié la boucle en utilisant While / Wend.
Le chrono mètre compte "00:00:01" mais j'obtiens le message suivant sur Application.DoEvents /
Erreur d'exécution '438'
Propriété ou méthode non gérée par cet objet.

Mince, encore été trop vite, DoEvents tout seul sans le Application
(j'étais trop pressé d'aller manger quand j'ai posté ma réponse :mrgreen:)
04/07/2023, 16h56
puledro

Pour info.
Le code d'Umfred n'a pas fonctionné correctement. Le chronomètre s'est emballé avec les secondes qui ressemblait plutôt à des centièmes de seconde. La fermeture du formulaire faisait ensuite planter Excel.
Le code de jurassic pork fonctionne nickel.
Merci à tous pour votre contribution.
04/07/2023, 17h27
umfred

erf, j'étais vraiment pas bien concentré sur ce sujet, désolé :bug:
04/07/2023, 17h30
deedolith

Note:
VBA (office) et la gestion du temps, c'est assez casse-gueule et imprécis.
Ce n'est tout simplement pas conçu pour faire du temps réel.

A limiter au strict nécessaire.
04/07/2023, 18h11
puledro

Le chronomètre est juste là à titre informatif.
Le temps que j'utilise pour évaluer la performance est la différence en deux cellules dans lesquelles je suis allé écrire l'instruction Now à deux instants différents.
J'ose imaginer que je ne vais pas avoir de grosses approximations.

2 pièce(s) jointe(s)

Hello,
je reviens sur le sujet car il y a au moins deux problèmes si on utilise Application.OnTime pour incrémenter le chronomètre :
Si on lance le formulaire en mode non modal (vbModeless) pour pouvoir manipuler la feuille pendant l'incrémentation :
1 - On voit que le curseur change furtivement(mode busy)
2 - Si on fait une action bloquante sur la feuille (exemples sélection de cellules, saisie) cela coince l'incrémentation.

C'est pour cela qu'il est préférable d'utiliser les API Timer windows ( voir le code de kiki29 ici )
J'ai effectué un léger changement dans le code de kiki29 pour le rendre compatible Excel 64 bits (pas testé) dans les déclarations des API :
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 ' windows api timer functions #If VBA7 And Win64 Then ' 64-bit Public Declare PtrSafe Function SetTimer Lib "user32" ( _ ByVal HWnd As LongLong, ByVal nIDEvent As LongLong, _ ByVal uElapse As LongLong, _ ByVal lpTimerFunc As LongLong) As LongLong Public Declare PtrSafe Function KillTimer Lib "user32" ( _ ByVal HWnd As LongLong, _ ByVal nIDEvent As LongLong) As LongLong #Else '32-bit Public Declare Function SetTimer Lib "user32" ( _ ByVal HWnd As Long, _ ByVal nIDEvent As Long, _ ByVal uElapse As Long, _ ByVal lpTimerFunc As Long) As Long Public Declare Function KillTimer Lib "user32" ( _ ByVal HWnd As Long, _ ByVal nIDEvent As Long) As Long #End If
Avec le code de kiki29 on a plus les deux problèmes énoncés ci-dessus.

Voici ce que cela donne en visualisant les 2 types de formulaires :
Pièce jointe 640991

En pièce jointe un classeur avec les deux formulaires.

Ami calmant, J.P

05/07/2023, 08h28
puledro

Bonjour,
Ce n'est pas mon cas mais c'est toujours bon à savoir !
Merci et bonne journée.