Re Chronomètre et minuteur sur un même écran Bis

Le 08/08/2020 à 09:10

Bonjour,

Pour reprendre un sujet de 2012, je cherche un fichier excel dans lequel je peux dupliquer le chrono fait par @Banzai64 précédemment, mais en mettre plusieurs sur la même page, voir même dupliquer les feuilles sachant que chaque feuilles sont indépendantes

15syofado-chrono-et-minuteur-v004.xlsm (24.75 Ko)
12syofado-chrono-et-minuteur-v001a.xlsm (176.61 Ko)

Je souhaiterai en clair reproduire le 4 tel que le 1 modifier et que chaque chrono soit donc indépendant. dernière question, est ce qu'un chrono sur la même ligne peut se mettre en route dès que le précédent horizontalement sur la même ligne est terminé ?

Merci beaucoup pour votre aide et bonne journée à tous

Le 09/08/2020 à 22:13

Bonjour toutes et tous

@ tester, recopier le code de Banzaï64 merci à lui, j'ajoute 1 sur les macros exemple ci-dessous etc pour les autres chronomètres

exemple sur la même page avec un chrono supplémentaire

32syofado-chrono-et-minuteur-v005.xlsm (38.90 Ko)
Option Explicit
' chrono 0
Dim DebChronoUp As Boolean
Dim DebChronoDown As Boolean
Dim HeureDep As Date

Dim DebChronoUp1 As Boolean ' rajouter
Dim DebChronoDown1 As Boolean ' rajouter
Dim HeureDep1 As Date

Sub Go()
  HeureDep = #12:00:00 AM#
  Depart
End Sub

Sub jyvais1()
  HeureDep1 = #12:00:00 AM#
  Depart1
End Sub

Sub Depart()

  If DebChronoUp = True Then Exit Sub     ' Le chrono Up est déjà lancé
  DebChronoUp = True                      ' Indique chrono Up en route
  DebChronoDown = False                   ' On arrête le chrono Down
  If HeureDep = 0 Then
    HeureDep = #12:00:00 AM#
  End If
  Range("D4") = Hour(HeureDep)
  Range("E4") = Minute(HeureDep)
  Range("F4") = Second(HeureDep)
  Application.OnTime Now + TimeValue("00:00:01"), "ChronoUp"
End Sub

Sub Decompte()
Dim Rep As String

  If DebChronoDown = True Then Exit Sub   ' Le chrono Down est déjà lancé
  DebChronoUp = False                     ' On arrête le chrono Up
  DebChronoDown = True                    ' Indique chrono Down en route
  If HeureDep = 0 Then
    Rep = InputBox("heure de départ - Maxi 23:59:59")
    If Not IsDate(Rep) Then Exit Sub
    HeureDep = TimeValue(Rep)
    If HeureDep = 0 Then Exit Sub
  End If
  Range("D4") = Hour(HeureDep)
  Range("E4") = Minute(HeureDep)
  Range("F4") = Second(HeureDep)
  Application.OnTime Now + TimeValue("00:00:01"), "ChronoDown"
End Sub

Sub Fin()
  DebChronoUp = False
  DebChronoDown = False
End Sub

Sub ChronoUp()
  If DebChronoUp = False Then Exit Sub
  HeureDep = HeureDep + #12:00:01 AM#
  Range("D4") = Hour(HeureDep)
  Range("E4") = Minute(HeureDep)
  Range("F4") = Second(HeureDep)
  If TimeValue(HeureDep) > 0 Then
    Application.OnTime Now + TimeValue("00:00:01"), "ChronoUp"
    DoEvents
  End If
End Sub

Sub ChronoDown()
  If DebChronoDown = False Then Exit Sub
  HeureDep = HeureDep - #12:00:01 AM#
  Range("D4") = Hour(HeureDep)
  Range("E4") = Minute(HeureDep)
  Range("F4") = Second(HeureDep)
  If TimeValue(HeureDep) > 0 Then
    Application.OnTime Now + TimeValue("00:00:01"), "ChronoDown"
    DoEvents
  End If
End Sub

Sub Reset()
  DebChronoUp = False
  DebChronoDown = False
  HeureDep = #12:00:00 AM#
  Range("D4") = Hour(HeureDep)
  Range("E4") = Minute(HeureDep)
  Range("F4") = Second(HeureDep)
End Sub
'-------------------------------------- autre chrono 1
' chrono 1

Sub Depart1()

  If DebChronoUp1 = True Then Exit Sub     ' Le chrono Up 1 est déjà lancé
  DebChronoUp1 = True                      ' Indique chrono Up 1 en route
  DebChronoDown1 = False                   ' On arrête le chrono Down 1
  If HeureDep1 = 0 Then
    HeureDep1 = #12:00:00 AM#
  End If
  Range("D10") = Hour(HeureDep1)   ' à modifier
  Range("E10") = Minute(HeureDep1) ' à modifier
  Range("F10") = Second(HeureDep1) ' à modifier
  Application.OnTime Now + TimeValue("00:00:01"), "ChronoUp1"
End Sub

Sub Decompte1()
Dim Rep1 As String

  If DebChronoDown1 = True Then Exit Sub   ' Le chrono Down est déjà lancé
  DebChronoUp1 = False                     ' On arrête le chrono Up
  DebChronoDown1 = True                    ' Indique chrono Down en route
  If HeureDep1 = 0 Then
    Rep1 = InputBox("heure de départ - Maxi 23:59:59")
    If Not IsDate(Rep1) Then Exit Sub
    HeureDep1 = TimeValue(Rep1)
    If HeureDep1 = 0 Then Exit Sub
  End If
  Range("D10") = Hour(HeureDep1)   ' à modifier
  Range("E10") = Minute(HeureDep1) ' à modifier
  Range("F10") = Second(HeureDep1) ' à modifier
  Application.OnTime Now + TimeValue("00:00:01"), "ChronoDown1"
End Sub

Sub Fin1()
  DebChronoUp1 = False
  DebChronoDown1 = False
End Sub

Sub ChronoUp1()
  If DebChronoUp1 = False Then Exit Sub
  HeureDep1 = HeureDep1 + #12:00:01 AM#
  Range("D10") = Hour(HeureDep1)   ' à modifier
  Range("E10") = Minute(HeureDep1) ' à modifier
  Range("F10") = Second(HeureDep1) ' à modifier
  If TimeValue(HeureDep1) > 0 Then
    Application.OnTime Now + TimeValue("00:00:01"), "ChronoUp1"
    DoEvents
  End If
End Sub

Sub ChronoDown1()
  If DebChronoDown1 = False Then Exit Sub
  HeureDep1 = HeureDep1 - #12:00:01 AM#
  Range("D10") = Hour(HeureDep1)    ' à modifier
  Range("E10") = Minute(HeureDep1)  ' à modifier
  Range("F10") = Second(HeureDep1)  ' à modifier
  If TimeValue(HeureDep1) > 0 Then
    Application.OnTime Now + TimeValue("00:00:01"), "ChronoDown1"
    DoEvents
  End If
End Sub

Sub Reset1()
  DebChronoUp1 = False
  DebChronoDown1 = False
  HeureDep1 = #12:00:00 AM#
  Range("D10") = Hour(HeureDep1)   ' à modifier
  Range("E10") = Minute(HeureDep1) ' à modifier
  Range("F10") = Second(HeureDep1) ' à modifier
End Sub
Rechercher des sujets similaires à "chronometre minuteur meme ecran bis"