Aide pour modifier un chronometre

pascal719 Messages postés 7 Date d'inscription mercredi 21 janvier 2009 Statut Membre Dernière intervention 11 février 2009 - 9 févr. 2009 à 11:56
pascal719 Messages postés 7 Date d'inscription mercredi 21 janvier 2009 Statut Membre Dernière intervention 11 février 2009 - 11 févr. 2009 à 15:55
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

9 réponses

cs_Exploreur Messages postés 4822 Date d'inscription lundi 11 novembre 2002 Statut Membre Dernière intervention 15 novembre 2016 14
9 févr. 2009 à 16:01
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 **
0
pascal719 Messages postés 7 Date d'inscription mercredi 21 janvier 2009 Statut Membre Dernière intervention 11 février 2009
9 févr. 2009 à 16:18
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
0
cs_Exploreur Messages postés 4822 Date d'inscription lundi 11 novembre 2002 Statut Membre Dernière intervention 15 novembre 2016 14
10 févr. 2009 à 09:50
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 **
0
cs_Exploreur Messages postés 4822 Date d'inscription lundi 11 novembre 2002 Statut Membre Dernière intervention 15 novembre 2016 14
10 févr. 2009 à 09:56
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 **
0

Vous n’avez pas trouvé la réponse que vous recherchez ?

Posez votre question
pascal719 Messages postés 7 Date d'inscription mercredi 21 janvier 2009 Statut Membre Dernière intervention 11 février 2009
10 févr. 2009 à 12:06
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
0
cs_Exploreur Messages postés 4822 Date d'inscription lundi 11 novembre 2002 Statut Membre Dernière intervention 15 novembre 2016 14
10 févr. 2009 à 12:33
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 **
0
cs_Exploreur Messages postés 4822 Date d'inscription lundi 11 novembre 2002 Statut Membre Dernière intervention 15 novembre 2016 14
11 févr. 2009 à 15:06
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 **
0
pascal719 Messages postés 7 Date d'inscription mercredi 21 janvier 2009 Statut Membre Dernière intervention 11 février 2009
11 févr. 2009 à 15:40
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
0
pascal719 Messages postés 7 Date d'inscription mercredi 21 janvier 2009 Statut Membre Dernière intervention 11 février 2009
11 févr. 2009 à 15:55
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
0