Aide pour modifier un chronometre

Question

Bonjour,

Je me sert du code suivant pour faire tourner un chrono :

Private fin_chrono As Long
Private Sub CommandButton1_Click()  'Bouton top/depart
Dim Depart As Double
Dim Temps As Double
CommandButton1.Enabled = False

fin_chrono = 0
Depart = [now()]
Do While fin_chrono = 0
    Temps = [now()] - Depart
        If CheckBox1 = True Then
        Label4.Caption = WorksheetFunction.Text(Temps, "mm:ss")
        Else
        Label4.Caption = WorksheetFunction.Text(Temps, "mm:ss")
    End If
DoEvents
Loop
0
End Sub
Private Sub CommandButton4_Click()   'Bouton Fin
If fin_chrono = 0 Then
    fin_chrono = 1
    CheckBox1 = False
    CommandButton1.Enabled = True
    ElseIf fin_chrono = 1 Then
    Label4.Caption = "00:00:00"
End If
End Sub

Or maintement je souhaite rajouter un bouton pause.

Pourriez vous m'aider.

Merci

Pascal

cs_Exploreur · Answer

Salut,

Sers toit d'une variable que tu passes à l'état TRUe avec ton bouton pause, qui une foi à TRUE sort de ta boucle de comptage....Pour reprendre ton comptage, repasse ta variable à False en prenant soin de récupérer le temps "mis en pause" pour reprendre ta boucle...

A+
Exploreur

 Linux a un noyau, Windows un pépin 
    ** http://exploreur1.labrute.fr **

pascal719 · Answer

Merci pour ta réponse.

Mais je suis novice en vb donc peux tu m'apporter ton aide car le code utilisé viens d'un programme que j'ai trouvé sur un site.

Merci pour ton aide.

A+

Pascal

cs_Exploreur · Answer

Salut,

Bon, j'ai fait une petite bidouille sous VB6 qui fonctionne mais qui n'est pas optimisée, mais je pense que tu devrais pouvoir transcrire cela en VBA...car j'ai un doute pour : TIMER.

ouvre un projet, ajoute 3 boutons et un label et colle le code ci-dessous...donne à tes contrôles les même noms que je leurs donnent dans le code(en rouge).

Option Explicit


Dim bPause As Boolean 'Pause
Dim bStop  As Boolean ' Fin




Private Sub Cmd_Go_Click()
  
  '-* Déclaration
      Dim dDepart As Double
      Dim dValue  As Double
      
      
  '-* init
      bStop = False
      bPause = False
      dValue = 1
      dDepart = Timer
                         
Encore:
  
  '-* Boucle
      Do While Timer < dDepart + dValue         If (bPause True) Or (bStop True) Then GoTo Fin
         DoEvents
      Loop


      '-* Mise à jour du label
      Lbl_Chrono.Caption = Format(CDate(DateAdd("S", 1, CDate(Lbl_Chrono.Caption))), "HH:NN:SS")
      
      '-* init
      dValue = 1
      dDepart = Timer
 
      GoTo Encore
      
Fin:
      
      If bStop Then Lbl_Chrono.Caption = "00:00:00"


End Sub




Private Sub Cmd_Pause_Click()


  '-* Init
      bPause = True
      
End Sub




Private Sub Cmd_stop_Click()


  '-* Fin du chrono et init
      bStop = True
      
End Sub


A+
Exploreur

 Linux a un noyau, Windows un pépin 
    ** http://exploreur1.labrute.fr **

cs_Exploreur · Answer

Et oui....

Remplace la partie du code par celà :

Private Sub Cmd_Go_Click()
  
  '-* Déclaration
      Dim dDepart As Double
      Dim dValue  As Double
      
      
  '-* init
      bStop = False
      bPause = False


Encore:


      dValue = 1
      dDepart = Timer
                         


  
  '-* Boucle
      Do While Timer < dDepart + dValue         If (bPause True) Or (bStop True) Then GoTo Fin
         DoEvents
      Loop


      '-* Mise à jour du label
      Lbl_Chrono.Caption = Format(CDate(DateAdd("S", 1, CDate(Lbl_Chrono.Caption))), "HH:NN:SS")
      
      GoTo Encore
      
Fin:
      
      If bStop Then Lbl_Chrono.Caption = "00:00:00"


End Sub

A+
Exploreur

 Linux a un noyau, Windows un pépin 
    ** http://exploreur1.labrute.fr **

pascal719 · Answer

Merci pour ta réponse, mais j'ai une erreur " incompatibilite de type" avec la ligne en jaune voici le code que j'ai installé:

Option Explicit
Dim bPause As Boolean 'Pause
Dim bStop  As Boolean ' Fin
Private Sub Cmd_Go_Click()
  '-* Déclaration
      Dim dDepart As Double
      Dim dValue  As Double     
  '-* init
      bStop = False
      bPause = False
Encore:
       dValue = 1
      dDepart = Timer
  '-* Boucle
      Do While Timer < dDepart + dValue         If (bPause True) Or (bStop True) Then GoTo Fin
         DoEvents
      Loop
      '-* Mise à jour du label
       
        Lbl_CHRONO.Caption = Format(CDate(DateAdd("S", 1, CDate(Lbl_CHRONO.Caption))), "HH:NN:SS")
        
      GoTo Encore
     
Fin:
     
      If bStop Then Lbl_CHRONO.Caption = "00:00:00"

End Sub

Private Sub Cmd_Pause_Click()

  '-* Init
      bPause = True
     
End Sub

Private Sub Cmd_stop_Click()

  '-* Fin du chrono et init
      bStop = True
     
End Sub

Je te remercie de me dire ou se situe l'erreur.

Merci 

Pascal

cs_Exploreur · Answer

Re,

Va falloir regarder un peu çà....3 possibilités :

Soit DateAdd ne fonctionne pas sous VBA
Soit CDate ne fontionne pas sous VBA
Soit Format ne fonctionne pas sous VBA

Essaye de voir sur le net si tu trouves des infos, soit attendre qu'un membre réponde à ta demande.....

A+
Exploreur

 Linux a un noyau, Windows un pépin 
    ** http://exploreur1.labrute.fr **

cs_Exploreur · Answer

Re,

Le problème que tu soulèves est bizarre, car je viens de faire l'essai dans Excel et tout fonctionne....Regarde que tu as bien donné les bons noms au contrôles(propriété Name des contrôles ^^)....

Lbl_chrono
Cmd_Go
Cmd_Stop
Cmd_Pause

A+
Exploreur

 Linux a un noyau, Windows un pépin 
    ** http://exploreur1.labrute.fr **

pascal719 · Answer

Bonjour Exploreur,

Je sais d'où venait mon erreur, il me manque ce code : 
Private Sub UserForm_Initialize()
Lbl_CHRONO.Caption = "00:00"
End Sub

pour que cela fonction.

Mais la commande stop-initialisation ne fonction pas chez moi.

Pourtant, je lui est donné le bon nom.

Voici le code :
Option Explicit
Dim bPause As Boolean 'Pause
Dim bStop As Boolean ' Fin
Private Sub UserForm_Initialize()
Lbl_CHRONO.Caption = "00:00"
End Sub
Private Sub Cmd_Go_Click()
 
  '-* Déclaration
      Dim dDepart As Double
      Dim dValue  As Double
     
     
  '-* init
      bStop = False
      bPause = False

Encore:

      dValue = 1
      dDepart = Timer
                        

 
  '-* Boucle
      Do While Timer < dDepart + dValue         If (bPause True) Or (bStop True) Then GoTo Fin
         DoEvents
      Loop

      '-* Mise à jour du label
      Lbl_CHRONO.Caption = Format(CDate(DateAdd("S", 1, CDate(Lbl_CHRONO.Caption))), "HH:MM:SS")
     
      GoTo Encore
     
Fin:
     
      If bStop Then Lbl_CHRONO.Caption = "00:00:00"

End Sub
Private Sub Cmd_Pause_Click()

'-* Init
bPause = True

End Sub
Private Sub Cmd_stop_Click()

'-* Fin du chrono et init
bStop = True

End Sub

Merci de ton aide

A+

Pascal

pascal719 · Answer

Re-bonjour,

En fait la commande RAZ fonctionne, mais je pensais pouvoir l'activé en mode pause.

Merci pour ce coup de main, pour en finir avec ce chrono, ne peut on pas s'afficher que les minutes et les secondes.

Merci 

A+

Pascal

Aide pour modifier un chronometre

9 réponses

Votre réponse

Discussions similaires