Aide pour modifier un chronometre

Signaler
Messages postés
7
Date d'inscription
mercredi 21 janvier 2009
Statut
Membre
Dernière intervention
11 février 2009
-
Messages postés
7
Date d'inscription
mercredi 21 janvier 2009
Statut
Membre
Dernière intervention
11 février 2009
-
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

Messages postés
4822
Date d'inscription
lundi 11 novembre 2002
Statut
Membre
Dernière intervention
15 novembre 2016
14
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 **
Messages postés
7
Date d'inscription
mercredi 21 janvier 2009
Statut
Membre
Dernière intervention
11 février 2009

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
Messages postés
4822
Date d'inscription
lundi 11 novembre 2002
Statut
Membre
Dernière intervention
15 novembre 2016
14
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 **
Messages postés
4822
Date d'inscription
lundi 11 novembre 2002
Statut
Membre
Dernière intervention
15 novembre 2016
14
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 **
Messages postés
7
Date d'inscription
mercredi 21 janvier 2009
Statut
Membre
Dernière intervention
11 février 2009

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
Messages postés
4822
Date d'inscription
lundi 11 novembre 2002
Statut
Membre
Dernière intervention
15 novembre 2016
14
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 **
Messages postés
4822
Date d'inscription
lundi 11 novembre 2002
Statut
Membre
Dernière intervention
15 novembre 2016
14
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 **
Messages postés
7
Date d'inscription
mercredi 21 janvier 2009
Statut
Membre
Dernière intervention
11 février 2009

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
Messages postés
7
Date d'inscription
mercredi 21 janvier 2009
Statut
Membre
Dernière intervention
11 février 2009

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