Décompte minutes - secondes Le sujet est résolu

Y compris Power BI, Power Query et toute autre question en lien avec Excel
r
rocket4
Membre impliqué
Membre impliqué
Messages : 1'204
Appréciations reçues : 3
Inscrit le : 30 août 2011
Version d'Excel : 2010

Message par rocket4 » 3 mars 2019, 10:01

Bonjour

je me suis amusé à créer ce petit bout de code ( un peu ch..) à faire ,il a pour but de décrire un compte à rebours mais n'aura jamais la précision d'une vraie horloge ..( c'est juste pour décrire la chose) .
En cells(1,1) on introduit les minutes au choix et en cells (1,2) on introduit le nombre de secondes au choix, puis on lance le décompte . Ce bout de code tourne , mais je ne le trouve pas "esthetique" du tout , peut on l'optimiser ? Merci
Sub decompte()

If Cells(1, 1) = 0 And Cells(1, 2) <> 0 Then
 Do
  Cells(1, 2) = Cells(1, 2) - 1
  Application.Wait Now + TimeValue("00:00:01")
 Loop Until Cells(1, 1) = 0 And Cells(1, 2) = 0
End If
'-----------------------------------------------
If Cells(1, 1) <> 0 And Cells(1, 2) = 0 Then
q = Cells(1, 1)
Cells(1, 1) = Cells(1, 1) - 1
j = 1
Do
Cells(1, 2) = (60 * j + Cells(1, 2) - 1) Mod 60
Application.Wait Now + TimeValue("00:00:01")
If Cells(1, 2) = 0 Then
  If Cells(1, 1) = 0 Then
     GoTo 1
   Else
     Cells(1, 1) = Cells(1, 1) - 1
  End If
1: j = j + 1
End If
Loop Until j = q + 1
End If
'-----------------------------------------------------------------------
If Cells(1, 1) <> 0 And Cells(1, 2) <> 0 Then
p = Cells(1, 1)
k = 0
Do
Cells(1, 2) = (60 * k + Cells(1, 2) - 1) Mod 60
Application.Wait Now + TimeValue("00:00:01")
If Cells(1, 2) = 0 Then
  If Cells(1, 1) = 0 Then
     GoTo 2
   Else
     Cells(1, 1) = Cells(1, 1) - 1
  End If
2: k = k + 1
End If

Loop Until k = p + 1
 End If
End Sub

Merci pour vos suggestions
h
h2so4
Passionné d'Excel
Passionné d'Excel
Messages : 8'988
Appréciations reçues : 359
Inscrit le : 16 juin 2013
Version d'Excel : 365 UK Windows 10

Message par h2so4 » 3 mars 2019, 10:15

bonjour,

une simplification possible
Sub decompte()
    Do Until Cells(1, 1) = 0 And Cells(1, 2) = 0
        nt = Now + TimeValue("00:00:01")
        If Cells(1, 2) > 0 Then Cells(1, 2) = Cells(1, 2) - 1 Else Cells(1, 2) = 59: Cells(1, 1) = Cells(1, 1) - 1
        Application.Wait nt
    Loop
End Sub
r
rocket4
Membre impliqué
Membre impliqué
Messages : 1'204
Appréciations reçues : 3
Inscrit le : 30 août 2011
Version d'Excel : 2010

Message par rocket4 » 3 mars 2019, 13:21

merci h2so4 , c'est en effet plus light ! :mrgreen: :mrgreen:
Répondre Sujet précédentSujet suivant
  • Sujets similaires
    Réponses
    Vues
    Dernier message