[VBA-E] Chronomètre pour memmory

Version imprimable

Bonjour à tous,
Je cherche à incorporer un chronomètre à l'aide de vba pour excel. Il est constitué de 4 boutons RAZ, Go, Stop, et ?. Je vais supprimer ce dernier qui ne me sert pas, mais là n'est pas le problème. Je vais vous montrer mon code placer dans feuil1:
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 Public vChrono Private Sub cmdChrono_Click() MsgBox Format(Now() - vChrono, "h:mm:ss"), vbOKOnly, "Chrono" End Sub Private Sub cmdGo_Click() cmdArret.Enabled = True cmdGo.Enabled = False cmdRAZ.Enabled = False vChrono = Now() - [B2] Do [B2] = Now() - vChrono DoEvents Loop End Sub Private Sub cmdArret_Click() cmdArret.Enabled = False cmdGo.Enabled = True cmdRAZ.Enabled = True vChrono = [B2] End End Sub Private Sub cmdRAZ_Click() [B2] = 0 End Sub
Le problème réside dans le fait que la valeur du chrono s'affichant en B2 et dans la fenêtre excel n'est pas 00:00:01........ mais 0,000048392.... et je ne sais pas comment résoudre ce petit problème. Si vous avez une petite solution cela m'aiderait grandement. De plus pourriez vous me dire comment afficher ce temps dans un label avec ce code?

Merci d'avance

Le problème de Time est qu'il va donner le temps en jour de 24h de 60 minutes de 60 secondes.
Si tu utilises GetTickCount& tu auras le temps en 1000ième de seconde.
Allez, comme c'est dimanche, et que tu me fais de la peine, regarde si ça te conviendrait ;)
Je te joins une copie de l'userform, comme ça tu n'auras rien à changer
Tu insères un module standard et un userform
Dans le module, tu mets ça

Code:

1
2
3
4
5
6
Public Declare Function GetTickCount& Lib "kernel32" ()
 
Sub auto_open()
Load Chronometre
Chronometre.Show
End Sub

Dans l'userform, que tu nommes "Chronometre" (c'est mieux pour que mon code marche :lol: ) tu mets les 4 boutons et les trois labels de l'image
Pièce jointe 10360
et dans la feuille de code de l'userform, tu mets

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
Option Explicit
Dim marche As Boolean, arret As Boolean
 
Private Sub QUITTER_Click()
End
End Sub
 
Sub chrono()
Dim départ As Double, ARRIVÉE As Double, durée As Double
Dim j As Long, i As Long, sd As Long, ms As Long
Dim mn As Long, tps As String, Temps As Double
    i = 14
    départ = GetTickCount&
    'DoEvents
    Do
        Do While marche And Not arret '-> le bouton PAUSE entraîne [marche = False] => Sortie de cette boucle
            ARRIVÉE = GetTickCount&
            durée = ARRIVÉE - départ
            Label1.Caption = durée
            DoEvents 'Laisse un délai pour l'affichage (tout petit petit...)
        Loop
        If Not arret And Not marche Then
            durée = ARRIVÉE - départ
            mn = Int(durée / 1000 / 60)
            sd = Int((durée / 1000) - (mn * 60))
            ms = durée - (sd * 1000) - (mn * 1000 * 60)
            tps = mn & ":" & sd & ":" & ms
            LabelTemp.Caption = tps
            Temps = Val(mn & "." & Right("00" & sd, 2) & Right("000" & ms, 3))
            DoEvents
            marche = True
        End If
 
    Loop Until arret
    durée = ARRIVÉE - départ
    mn = Int(durée / 1000 / 60)
    sd = Int((durée / 1000) - (mn * 60))
    ms = durée - (sd * 1000) - (mn * 1000 * 60)
    tps = mn & ":" & sd & ":" & Right("000" & ms, 3)
    LabelFin.Caption = tps
    Temps = Val(mn & "." & Right("00" & sd, 2) & Right("000" & ms, 3))
End Sub
 
Private Sub DEPART_Click()
If Not marche Then
    Init
    arret = False
    marche = True
    chrono
End If
End Sub
 
Private Sub PAUSE_Click()
Dim j As Long
marche = Not marche
For j = 1 To 10000
    DoEvents
Next
End Sub
 
Sub Init()
    LabelTemp.Caption = "00:00:00"
    LabelFin.Caption = "00:00:00"
End Sub
 
Private Sub ARRIVEE_Click()
arret = True
marche = False
End Sub
 
Private Sub UserForm_Initialize()
Init
End Sub

Quand t'as tout fait ça, tu fais F5

Tel que c'est écrit, on pourrait supprimer le bouton pause mais bon, j'aimais bien l'idée des boutons Marche Pause Arrêt
Tu dis si ça te convient ;)

Attention : J'ai un bouton ARRIVEE et une variable ARRIVÉE :cry: C'est pas bien mais c'est comme ça.

04/03/2007, 19h36
jhonnybegood

chronomètre sur feuille de calcul et non sur user

Merci pour ce geste mais il me reste un ptit problème.
Mon chronomètre devra s'afficher sur une feuille de calcul excel et non sur un userform, or userform.initialize est utilisé. Comment dois-je alors faire?

Désolé, si je suis nul c'est pas de ma faute c'est simplement du au fait que nous avons parlé de vba pendant 4h seulement en cours et nous nous sommes 'amusés' à créer des boutons (c'est quand même autre chose que de créer un chronomètre)

Merci d'avance
04/03/2007, 19h40
ouskel'n'or

Citation:

Envoyé par jhonnybegood

Merci pour ce geste mais il me reste un ptit problème.
Mon chronomètre devra s'afficher sur une feuille de calcul excel et non sur un userform, or userform.initialize est utilisé. Comment dois-je alors faire?

Tu dois insérer les temps dans une feuille de calcul ? Cépacompliké mais avant toute explication, dis-nous.
Profites-en pour préciser si les temps doivent aller l'un sous l'autre, l'un à côté de l'autre... Bref, dis-nous en plus ;)
A tout'
04/03/2007, 21h07
jhonnybegood

chrono pour memory

En fait le plan de jeu sera une feuille de calcul. Sur celle-ci je place mes 32 images (picture box), 2-3 boutons pour aller au menu principal.... et le chronomètre. Celui-ci se déclenchera au premier clic sur une image et s'arrêtera lorsque le joueur aura trouvé la dernière paire. Le temps écoulé va apparaître sur un label situé sur la feuille de calcul, et le temps devra resté visible.Voila toutes les précisions.
05/03/2007, 00h21
ouskel'n'or

En faisant ça sur une feuille de calculs, tu te compliques inutilement la vie. Les userforms sont faits pour ça. Ce problème pourrait âtre résolu en 10 mn avec le chrono que je t'ai passé dans la mesure... où les cartes existent. Je ne m'embarquerai pas à te conseiller pour faire ça sur une feuille de calculs
Désolé.
Je souhaite que tu trouves quelqu'un pour t'aider ;)
Bonne chance