Discussion :

[puledro]

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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.

[umfred]

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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

[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.

[deedolith]

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

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
While (condition)
Wend

PS: tu aurais dû t'en rendre compte, c'est la base de chez basique.

[umfred]

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

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
j'étais parti sur un While .. Loop mais dans ce cas, ça aurait été Do While .. Loop et j'ai corrigé trop rapidement

[jurassic pork]

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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

Ami calmant, J.P

[umfred]

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 )

[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.

[umfred]

erf, j'étais vraiment pas bien concentré sur ce sujet, désolé

[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.

[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.

[jurassic pork]

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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 :



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


Ami calmant, J.P

[puledro]

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