Faire un compte à rebours sur chaque feuille

Le 22/10/2019 à 22:16

Bonjour!

Toujours dans un apprentissage intensif de la VBA d'Excel pour finaliser un projet personnel, j'aimerais bien à l'aide de la programmation VBA réaliser pour chaque feuille d'un fichier un compte à rebours personnalisé.

Voici ce que j'ai déjà fait:

  • renommé toutes les feuilles en fonction de mes besoins,
  • insérer une zone de texte avec le temps que je jugeais nécessaire pour la feuille, qui se trouve toujours dans la même cellule "A1".
  • insérer des boutons de commande MARCHE et ARRET pour chaque feuille. A la feuille 1 ou une macro s'applique, on y retrouve aussi le bouton MARCHE 1 et ARRET 1. Etc. , etc. , pour les feuilles suivantes.
  • un code couleur, plus ou moins proportionnel au temps restant du compte à rebours. Sur le code ci-dessous, il ne s'applique que sur la toute première feuille de code. Mais néant pour les suivantes...

Où est le problème ? Est-ce que la fonction application.sheet doit-elle rentrer en ligne de compte? ou est-ce la manip .select?

Une personne peut elle m'aiguiller? Merci bcp pour l'aide précieuse apportée.

Le Code suivant, très lourd, peut surement être optimisé. Il faut simplement mieux s'y connaître que moi...

Disponible si vous avez des interrogations, ou désirez informations complémentaires ou si vous souhaitez que je vous envoie le fichier concerné si vous voulez y jeter un oeil un bazar.

Cordialement

LR

Public BoolStart As Boolean
Sub Marche1()
BoolStart = True
Application.OnTime Now + TimeValue("00:00:01"), "nexttick1"
End Sub

Sub nexttick1()
If BoolStart Then
    Sheets("Tout").Range("A1").Value = Sheets("Tout").Range("A1").Value - TimeValue("00:00:01")
    If Sheets("Tout").Range("A1") = 0 Then Exit Sub
    If Sheets("Tout").Range("A1").Value <= TimeValue("00:59:59") Then
    Sheets("Tout").Shapes("Text Box 1").Fill.ForeColor.RGB = RGB(0, 128, 0)
    End If
    If Sheets("Tout").Range("A1").Value <= TimeValue("00:29:59") Then
        Sheets("Tout").Shapes("Text Box 1").Fill.ForeColor.RGB = RGB(240, 195, 0)
    End If
    If Sheets("Tout").Range("A1").Value <= TimeValue("00:14:59") Then
        Sheets("Tout").Shapes("Text Box 1").Fill.ForeColor.RGB = RGB(204, 85, 0)
    End If
    If Sheets("Tout").Range("A1").Value <= TimeValue("00:04:59") Then
        Sheets("Tout").Shapes("Text Box 1").Fill.ForeColor.RGB = RGB(255, 0, 0)
    End If
    Marche1
End If
End Sub

Sub Arret1()
BoolStart = False
End Sub
Public BoolStart As Boolean

Sub Marche2()
BoolStart = True
Application.OnTime Now + TimeValue("00:00:01"), "nexttick2"
End Sub

Sub nexttick2()
If BoolStart Then
    Sheets("AEIOU full").Range("A1").Value = Sheets("AEIOU full").Range("A1").Value - TimeValue("00:00:01")
    If Sheets("AEIOU full").Range("A1") = 0 Then Exit Sub
    If Sheets("AEIOU full").Range("A1").Value <= TimeValue("00:20:59") Then
    Sheets("AEIOU full").Shapes("Text Box 2").Fill.ForeColor.RGB = RGB(0, 128, 0)
    End If
    If Sheets("AEIOU full").Range("A1").Value <= TimeValue("00:15:59") Then
        Sheets("AEIOU full").Shapes("Text Box 2").Fill.ForeColor.RGB = RGB(240, 195, 0)
    End If
    If Sheets("AEIOU full").Range("A1").Value <= TimeValue("00:10:59") Then
        Sheets("Tout").Shapes("Text Box 2").Fill.ForeColor.RGB = RGB(204, 85, 0)
    End If
    If Sheets("AEIOU full").Range("A1").Value <= TimeValue("00:03:59") Then
        Sheets("AEIOU full").Shapes("Text Box 2").Fill.ForeColor.RGB = RGB(255, 0, 0)
    End If
    Marche2
End If
End Sub

Sub Arret2()
BoolStart = False
End Sub
Public BoolStart As Boolean

Sub Marche3()
BoolStart = True
Application.OnTime Now + TimeValue("00:00:01"), "nexttick3"
End Sub

Sub nexttick3()
If BoolStart Then
    Sheets("AEOU conj").Range("A1").Value = Sheets("Tout").Range("A1").Value - TimeValue("00:00:01")
    If Sheets("AEOU conj").Range("A1") = 0 Then Exit Sub
    If Sheets("AEOU conj").Range("A1").Value <= TimeValue("00:02:29") Then
    Sheets("AEOU conj").Shapes("Text Box 3").Fill.ForeColor.RGB = RGB(0, 128, 0)
    End If
    If Sheets("AEOU conj").Range("A1").Value <= TimeValue("00:01:49") Then
        Sheets("AEOU conj").Shapes("Text Box 3").Fill.ForeColor.RGB = RGB(240, 195, 0)
    End If
    If Sheets("AEOU conj").Range("A1").Value <= TimeValue("00:0:59") Then
        Sheets("AEOU conj").Shapes("Text Box 3").Fill.ForeColor.RGB = RGB(204, 85, 0)
    End If
    If Sheets("AEOU conj").Range("A1").Value <= TimeValue("00:0:29") Then
        Sheets("AEOU conj").Shapes("Text Box 3").Fill.ForeColor.RGB = RGB(255, 0, 0)
    End If
    Marche3
End If
End Sub

Sub Arret3()
BoolStart = False
End Sub

Public BoolStart As Boolean

Sub Marche4()
BoolStart = True
Application.OnTime Now + TimeValue("00:00:01"), "nexttick4"
End Sub

Sub nexttick4()
If BoolStart Then
    Sheets("AEIO lc").Range("A1").Value = Sheets("AEIO lc").Range("A1").Value - TimeValue("00:00:01")
    If Sheets("AEIO lc").Range("A1") = 0 Then Exit Sub
    If Sheets("AEIO lc").Range("A1").Value <= TimeValue("00:11:29") Then
    Sheets("AEIO lc").Shapes("Text Box 4").Fill.ForeColor.RGB = RGB(0, 128, 0)
    End If
    If Sheets("AEIO lc").Range("A1").Value <= TimeValue("00:08:59") Then
        Sheets("AEIOU full").Shapes("Text Box 4").Fill.ForeColor.RGB = RGB(240, 195, 0)
    End If
    If Sheets("AEIO lc").Range("A1").Value <= TimeValue("00:5:59") Then
        Sheets("AEIO lc").Shapes("Text Box 4").Fill.ForeColor.RGB = RGB(204, 85, 0)
    End If
    If Sheets("AEIO lc").Range("A1").Value <= TimeValue("00:01:59") Then
        Sheets("AEIO lc").Shapes("Text Box 4").Fill.ForeColor.RGB = RGB(255, 0, 0)
    End If
    Marche4
End If
End Sub

Sub Arret4()
BoolStart = False
End Sub

Sub Marche5()
BoolStart = True
Application.OnTime Now + TimeValue("00:00:01"), "nexttick5"
End Sub

Sub nexttick5()
If BoolStart Then
    Sheets("LNRST full").Range("A1").Value = Sheets("AEIO lc").Range("A1").Value - TimeValue("00:00:01")
    If Sheets("LNRST full").Range("A1") = 0 Then Exit Sub
    If Sheets("LNRST full").Range("A1").Value <= TimeValue("00:11:29") Then
    Sheets("LNRST full").Shapes("Text Box 5").Fill.ForeColor.RGB = RGB(0, 128, 0)
    End If
    If Sheets("LNRST full").Range("A1").Value <= TimeValue("00:08:59") Then
        Sheets("LNRST full").Shapes("Text Box 5").Fill.ForeColor.RGB = RGB(240, 195, 0)
    End If
    If Sheets("LNRST full").Range("A1").Value <= TimeValue("00:5:59") Then
        Sheets("LNRST full").Shapes("Text Box 5").Fill.ForeColor.RGB = RGB(204, 85, 0)
    End If
    If Sheets("LNRST full").Range("A1").Value <= TimeValue("00:01:59") Then
        Sheets("LNRST full").Shapes("Text Box 5").Fill.ForeColor.RGB = RGB(255, 0, 0)
    End If
    Marche5
Sheet("Tout").Activate
End If
End Sub

Sub Arret5()
BoolStart = False
End Sub

Sub Marche6()
BoolStart = True
Application.OnTime Now + TimeValue("00:00:01"), "nexttick6"
End Sub

Sub nexttick6()
If BoolStart Then
    Sheets("LNRST conj").Range("A1").Value = Sheets("LNRST conj").Range("A1").Value - TimeValue("00:00:01")
    If Sheets("LNRST conj").Range("A1") = 0 Then Exit Sub
    If Sheets("LNRST conj").Range("A1").Value <= TimeValue("00:11:29") Then
    Sheets("LNRST conj").Shapes("Text Box 6").Fill.ForeColor.RGB = RGB(0, 128, 0)
    End If
    If Sheets("LNRST conj").Range("A1").Value <= TimeValue("00:08:59") Then
        Sheets("LNRST conj").Shapes("Text Box 6").Fill.ForeColor.RGB = RGB(240, 195, 0)
    End If
    If Sheets("LNRST conj").Range("A1").Value <= TimeValue("00:5:59") Then
        Sheets("LNRST conj").Shapes("Text Box 6").Fill.ForeColor.RGB = RGB(204, 85, 0)
    End If
    If Sheets("LNRST conj").Range("A1").Value <= TimeValue("00:01:59") Then
        Sheets("LNRST conj").Shapes("Text Box 6").Fill.ForeColor.RGB = RGB(255, 0, 0)
    End If
    Marche6
End If
End Sub

Sub Arret6()
BoolStart = False
End Sub

Sub Marche7()
BoolStart = True
Application.OnTime Now + TimeValue("00:00:01"), "nexttick7"
End Sub

Sub nexttick7()
If BoolStart Then
    Sheets("LNRST lc").Range("A1").Value = Sheets("LNRST lc").Range("A1").Value - TimeValue("00:00:01")
    If Sheets("LNRST lc").Range("A1") = 0 Then Exit Sub
    If Sheets("LNRST lc").Range("A1").Value <= TimeValue("00:04:59") Then
    Sheets("LNRST lc").Shapes("Text Box 7").Fill.ForeColor.RGB = RGB(0, 128, 0)
    End If
    If Sheets("LNRST lc").Range("A1").Value <= TimeValue("00:02:59") Then
        Sheets("LNRST lc").Shapes("Text Box 7").Fill.ForeColor.RGB = RGB(240, 195, 0)
    End If
    If Sheets("LNRST lc").Range("A1").Value <= TimeValue("00:1:39") Then
        Sheets("LNRST lc").Shapes("Text Box 7").Fill.ForeColor.RGB = RGB(204, 85, 0)
    End If
    If Sheets("LNRST lc").Range("A1").Value <= TimeValue("00:00:49") Then
        Sheets("LNRST lc").Shapes("Text Box 7").Fill.ForeColor.RGB = RGB(255, 0, 0)
    End If
    Marche7
End If
End Sub

Sub Arret7()
BoolStart = False
End Sub

Sub Marche9()
BoolStart = True
Application.OnTime Now + TimeValue("00:00:01"), "nexttick9"
End Sub

Sub nexttick9()
If BoolStart Then
    Sheets("BCDP conj").Range("A1").Value = Sheets("BCDP conj").Range("A1").Value - TimeValue("00:00:01")
    If Sheets("BCDP conj").Range("A1") = 0 Then Exit Sub
    If Sheets("BCDP conj").Range("A1").Value <= TimeValue("00:04:59") Then
    Sheets("BCDP conj").Shapes("Text Box 9").Fill.ForeColor.RGB = RGB(0, 128, 0)
    End If
    If Sheets("BCDP conj").Range("A1").Value <= TimeValue("00:02:59") Then
        Sheets("BCDP conj").Shapes("Text Box 9").Fill.ForeColor.RGB = RGB(240, 195, 0)
    End If
    If Sheets("BCDP conj").Range("A1").Value <= TimeValue("00:1:39") Then
        Sheets("BCDP conj").Shapes("Text Box 9").Fill.ForeColor.RGB = RGB(204, 85, 0)
    End If
    If Sheets("BCDP conj").Range("A1").Value <= TimeValue("00:00:49") Then
        Sheets("BCDP conj").Shapes("Text Box 9").Fill.ForeColor.RGB = RGB(255, 0, 0)
    End If
    Marche9
End If
End Sub

Sub Arret9()
BoolStart = False
End Sub

Sub Marche10()
BoolStart = True
Application.OnTime Now + TimeValue("00:00:01"), "nexttick10"
End Sub

Sub nexttick10()
If BoolStart Then
    Sheets("BCDP lc").Range("A1").Value = Sheets("BCDP lc").Range("A1").Value - TimeValue("00:00:01")
    If Sheets("BCDP lc").Range("A1") = 0 Then Exit Sub
    If Sheets("BCDP lc").Range("A1").Value <= TimeValue("00:04:59") Then
    Sheets("BCDP lc").Shapes("Text Box 10").Fill.ForeColor.RGB = RGB(0, 128, 0)
    End If
    If Sheets("BCDP lc").Range("A1").Value <= TimeValue("00:02:59") Then
        Sheets("BCDP lc").Shapes("Text Box 10").Fill.ForeColor.RGB = RGB(240, 195, 0)
    End If
    If Sheets("BCDP lc").Range("A1").Value <= TimeValue("00:1:39") Then
        Sheets("BCDP conj").Shapes("Text Box 10").Fill.ForeColor.RGB = RGB(204, 85, 0)
    End If
    If Sheets("BCDP lc").Range("A1").Value <= TimeValue("00:00:49") Then
        Sheets("BCDP lc").Shapes("Text Box 10").Fill.ForeColor.RGB = RGB(255, 0, 0)
    End If
    Marche10
End If
End Sub

Sub Arret10()
BoolStart = False
End Sub

Sub Marche8()
BoolStart = True
Application.OnTime Now + TimeValue("00:00:01"), "nexttick8"
End Sub

Sub nexttick8()
If BoolStart Then
    Sheets("BCDP full").Range("A1").Value = Sheets("BCDP full").Range("A1").Value - TimeValue("00:00:01")
    If Sheets("BCDP full").Range("A1") = 0 Then Exit Sub
    If Sheets("BCDP full").Range("A1").Value <= TimeValue("00:19:59") Then
    Sheets("BCDP full").Shapes("Text Box 8").Fill.ForeColor.RGB = RGB(0, 128, 0)
    End If
    If Sheets("BCDP full").Range("A1").Value <= TimeValue("00:13:59") Then
        Sheets("BCDP full").Shapes("Text Box 8").Fill.ForeColor.RGB = RGB(240, 195, 0)
    End If
    If Sheets("BCDP full").Range("A1").Value <= TimeValue("00:8:59") Then
        Sheets("BCDP full").Shapes("Text Box 8").Fill.ForeColor.RGB = RGB(204, 85, 0)
    End If
    If Sheets("BCDP full").Range("A1").Value <= TimeValue("00:02:59") Then
        Sheets("BCDP full").Shapes("Text Box 8").Fill.ForeColor.RGB = RGB(255, 0, 0)
    End If
    Marche8
End If
End Sub

Sub Arret8()
BoolStart = False
End Sub

Sub Marche11()
BoolStart = True
Application.OnTime Now + TimeValue("00:00:01"), "nexttick11"
End Sub

Sub nexttick11()
If BoolStart Then
    Sheets("FGHMV full").Range("A1").Value = Sheets("FGHMV full").Range("A1").Value - TimeValue("00:00:01")
    If Sheets("FGHMV full").Range("A1") = 0 Then Exit Sub
    If Sheets("FGHMV full").Range("A1").Value <= TimeValue("00:16:59") Then
    Sheets("FGHMV full").Shapes("Text Box 11").Fill.ForeColor.RGB = RGB(0, 128, 0)
    End If
    If Sheets("FGHMV full").Range("A1").Value <= TimeValue("00:12:59") Then
        Sheets("FGHMV full").Shapes("Text Box 11").Fill.ForeColor.RGB = RGB(240, 195, 0)
    End If
    If Sheets("FGHMV full").Range("A1").Value <= TimeValue("00:8:59") Then
        Sheets("FGHMV full").Shapes("Text Box 11").Fill.ForeColor.RGB = RGB(204, 85, 0)
    End If
    If Sheets("FGHMV full").Range("A1").Value <= TimeValue("00:02:29") Then
        Sheets("FGHMV full").Shapes("Text Box 11").Fill.ForeColor.RGB = RGB(255, 0, 0)
    End If
    Marche11
End If
End Sub

Sub Arret11()
BoolStart = False
End Sub

Sub Marche12()
BoolStart = True
Application.OnTime Now + TimeValue("00:00:01"), "nexttick12"
End Sub

Sub nexttick12()
If BoolStart Then
    Sheets("FGHMV conj").Range("A1").Value = Sheets("FGHMV conj").Range("A1").Value - TimeValue("00:00:01")
    If Sheets("FGHMV conj").Range("A1") = 0 Then Exit Sub
    If Sheets("FGHMV conj").Range("A1").Value <= TimeValue("00:6:59") Then
    Sheets("FGHMV conj").Shapes("Text Box 17").Fill.ForeColor.RGB = RGB(0, 128, 0)
    End If
    If Sheets("FGHMV conj").Range("A1").Value <= TimeValue("00:4:59") Then
        Sheets("FGHMV conj").Shapes("Text Box 17").Fill.ForeColor.RGB = RGB(240, 195, 0)
    End If
    If Sheets("FGHMV conj").Range("A1").Value <= TimeValue("00:1:59") Then
        Sheets("FGHMV full").Shapes("Text Box 17").Fill.ForeColor.RGB = RGB(204, 85, 0)
    End If
    If Sheets("FGHMV conj").Range("A1").Value <= TimeValue("00:00:59") Then
        Sheets("FGHMV conj").Shapes("Text Box 17").Fill.ForeColor.RGB = RGB(255, 0, 0)
    End If
    Marche12
End If
End Sub

Sub Arret12()
BoolStart = False
End Sub

Sub Marche13()
BoolStart = True
Application.OnTime Now + TimeValue("00:00:01"), "nexttick13"
End Sub

Sub nexttick13()
If BoolStart Then
    Sheets("FGHMV lc").Range("A1").Value = Sheets("FGHMV conj").Range("A1").Value - TimeValue("00:00:01")
    If Sheets("FGHMV lc").Range("A1") = 0 Then Exit Sub
    If Sheets("FGHMV lc").Range("A1").Value <= TimeValue("00:5:59") Then
    Sheets("FGHMV lc").Shapes("Text Box 16").Fill.ForeColor.RGB = RGB(0, 128, 0)
    End If
    If Sheets("FGHMV lc").Range("A1").Value <= TimeValue("00:3:59") Then
        Sheets("FGHMV lc").Shapes("Text Box 16").Fill.ForeColor.RGB = RGB(240, 195, 0)
    End If
    If Sheets("FGHMV lc").Range("A1").Value <= TimeValue("00:1:29") Then
        Sheets("FGHMV full").Shapes("Text Box 16").Fill.ForeColor.RGB = RGB(204, 85, 0)
    End If
    If Sheets("FGHMV lc").Range("A1").Value <= TimeValue("00:00:29") Then
        Sheets("FGHMV lc").Shapes("Text Box 16").Fill.ForeColor.RGB = RGB(255, 0, 0)
    End If
    Marche13
End If
End Sub

Sub Arret13()
BoolStart = False
End Sub

Sub Marche14()
BoolStart = True
Application.OnTime Now + TimeValue("00:00:01"), "nexttick14"
End Sub

Sub nexttick14()
If BoolStart Then
    Sheets("lc autres").Range("A1").Value = Sheets("lc autres").Range("A1").Value - TimeValue("00:00:01")
    If Sheets("lc autres").Range("A1") = 0 Then Exit Sub
    If Sheets("lc autres").Range("A1").Value <= TimeValue("00:20:59") Then
    Sheets("lc autres").Shapes("Text Box 12").Fill.ForeColor.RGB = RGB(0, 128, 0)
    End If
    If Sheets("lc autres").Range("A1").Value <= TimeValue("00:15:59") Then
        Sheets("lc autres").Shapes("Text Box 12").Fill.ForeColor.RGB = RGB(240, 195, 0)
    End If
    If Sheets("lc autres").Range("A1").Value <= TimeValue("00:10:59") Then
        Sheets("lc autres").Shapes("Text Box 12").Fill.ForeColor.RGB = RGB(204, 85, 0)
    End If
    If Sheets("lc autres").Range("A1").Value <= TimeValue("00:03:59") Then
        Sheets("lc autres").Shapes("Text Box 12").Fill.ForeColor.RGB = RGB(255, 0, 0)
    End If
    Marche14
End If
End Sub

Sub Arret14()
BoolStart = False
End Sub

Sub Marche15()
BoolStart = True
Application.OnTime Now + TimeValue("00:00:01"), "nexttick15"
End Sub

Sub nexttick15()
If BoolStart Then
    Sheets("JKQWXYZ").Range("A1").Value = Sheets("JKQWXYZ").Range("A1").Value - TimeValue("00:00:01")
    If Sheets("JKQWXYZ").Range("A1") = 0 Then Exit Sub
    If Sheets("JKQWXYZ").Range("A1").Value <= TimeValue("00:3:59") Then
    Sheets("JKQWXYZ").Shapes("Text Box 13").Fill.ForeColor.RGB = RGB(0, 128, 0)
    End If
    If Sheets("JKQWXYZ").Range("A1").Value <= TimeValue("00:2:39") Then
        Sheets("JKQWXYZ").Shapes("Text Box 13").Fill.ForeColor.RGB = RGB(240, 195, 0)
    End If
    If Sheets("JKQWXYZ").Range("A1").Value <= TimeValue("00:1:29") Then
        Sheets("JKQWXYZ").Shapes("Text Box 13").Fill.ForeColor.RGB = RGB(204, 85, 0)
    End If
    If Sheets("JKQWXYZ").Range("A1").Value <= TimeValue("00:00:29") Then
        Sheets("JKQWXYZ").Shapes("Text Box 13").Fill.ForeColor.RGB = RGB(255, 0, 0)
    End If
    Marche15
End If
End Sub

Sub Arret15()
BoolStart = False
End Sub

Sub Marche16()
BoolStart = True
Application.OnTime Now + TimeValue("00:00:01"), "nexttick16"
End Sub

Sub nexttick16()
If BoolStart Then
    Sheets("lc full").Range("A1").Value = Sheets("lc full").Range("A1").Value - TimeValue("00:00:01")
    If Sheets("lc full").Range("A1") = 0 Then Exit Sub
    If Sheets("lc full").Range("A1").Value <= TimeValue("00:24:59") Then
    Sheets("lc full").Shapes("Text Box 14").Fill.ForeColor.RGB = RGB(0, 128, 0)
    End If
    If Sheets("lc full").Range("A1").Value <= TimeValue("00:16:39") Then
        Sheets("lc full").Shapes("Text Box 14").Fill.ForeColor.RGB = RGB(240, 195, 0)
    End If
    If Sheets("lc full").Range("A1").Value <= TimeValue("00:8:59") Then
        Sheets("lc full").Shapes("Text Box 14").Fill.ForeColor.RGB = RGB(204, 85, 0)
    End If
    If Sheets("lc full").Range("A1").Value <= TimeValue("00:02:59") Then
        Sheets("lc full").Shapes("Text Box 14").Fill.ForeColor.RGB = RGB(255, 0, 0)
    End If
    Marche16
End If
End Sub

Sub Arret16()
BoolStart = False
End Sub

Sub Marche17()
BoolStart = True
Application.OnTime Now + TimeValue("00:00:01"), "nexttick17"
End Sub

Sub nexttick17()
If BoolStart Then
    Sheets("lc full sans conj").Range("A1").Value = Sheets("lc full sans conj").Range("A1").Value - TimeValue("00:00:01")
    If Sheets("lc full sans conj").Range("A1") = 0 Then Exit Sub
    If Sheets("lc full sans conj").Range("A1").Value <= TimeValue("00:14:59") Then
    Sheets("lc full sans conj").Shapes("Text Box 15").Fill.ForeColor.RGB = RGB(0, 128, 0)
    End If
    If Sheets("lc full sans conj").Range("A1").Value <= TimeValue("00:8:59") Then
        Sheets("lc full sans conj").Shapes("Text Box 15").Fill.ForeColor.RGB = RGB(240, 195, 0)
    End If
    If Sheets("lc full sans conj").Range("A1").Value <= TimeValue("00:5:59") Then
        Sheets("lc full sans conj").Shapes("Text Box 15").Fill.ForeColor.RGB = RGB(204, 85, 0)
    End If
    If Sheets("lc full sans conj").Range("A1").Value <= TimeValue("00:01:59") Then
        Sheets("lc full sans conj").Shapes("Text Box 15").Fill.ForeColor.RGB = RGB(255, 0, 0)
    End If
    Marche17
End If
End Sub

Sub Arret17()
BoolStart = False
End Sub
Le 25/10/2019 à 12:18

Bonjour Lucrob,

Dans un premier temps je te suggère de compiler le code VBA : plusieurs erreurs sont à corriger.

Je pense qu'il y a moyen de grandement réduire ce code afin de ne pas le démultiplier par le nombre de feuilles à traiter.

Peux-tu joindre le classeur ?

Le 26/10/2019 à 17:29

Bonjour Gérard,

Merci pour votre message.

Vous trouverez le fichier joint en annexe. Normalement dans le fichier, j'y ai inséré un module avec le code précédent.

Merci pour votre aide précieuse pour m'aider à simplifier ce schmilblick.

Bon week-end...

Lucrob

4tirages-7-lettres-ods-8-uniq-jeux-interactifs-lr-1.xlsx (212.97 Ko)
Le 27/10/2019 à 01:03

Bonsoir Lucrob,

Je te propose ceci :

  • On dissocie le compteur d'affichage de la cellule "A1" contenant le temps alloué pour la feuille.
  • Plutôt que des boutons "Active X" pour les actions "Marche"/"Arrêt" on utilise des boutons "Contrôle de formulaire".
  • On ajoute un bouton "Réinitialisation" permettant d'affecter le temps alloué au compteur de la feuille.
  • On affecte le même nom "TempsAlloué" aux cellules "A1" des toutes les feuilles.
  • On affecte le même nom "Compteur" a la forme "Compteur" de toutes les feuilles.
  • On ajoute le code suivant dans un module afin qu'il soit accessibles de toutes les feuilles du classeur :
Option Explicit
Public BoolStart As Boolean
Sub Marche()
    BoolStart = True
    Application.OnTime Now + TimeValue("00:00:01"), "nexttick"
End Sub
Sub nexttick()
    Dim oShape As Shape
    Dim oCellTempsAlloue As Range
    Dim dCompteur As Date
    If BoolStart Then
        'On refère le compteur de la feuille active
        Set oShape = ActiveSheet.Shapes("Compteur")
        'On réfère la cellule contenant le temps alloué pour la fuuille active
        Set oCellTempsAlloue = ActiveSheet.Names("TempsAlloue").RefersToRange
        'On récupère la valeur du compteur et on défalque une seconde
        dCompteur = CDate(oShape.OLEFormat.Object.Caption) - TimeValue("00:00:01")
        'On réaffecte la valeur du compteur
        oShape.OLEFormat.Object.Caption = Format(dCompteur, "hh:nn:ss")

        'On colore le compteur en fonction de valeur
        Select Case dCompteur
            Case Is = 0
                Arret
            Case Is >= oCellTempsAlloue.Value / 2
                oShape.Fill.ForeColor.RGB = RGB(0, 128, 0)
                Marche
            Case Is >= oCellTempsAlloue.Value / 4
                oShape.Fill.ForeColor.RGB = RGB(240, 195, 0)
                Marche
            Case Is >= oCellTempsAlloue.Value / 10
                oShape.Fill.ForeColor.RGB = RGB(204, 85, 0)
                Marche
            Case Else
                oShape.Fill.ForeColor.RGB = RGB(255, 0, 0)
                Marche
        End Select
    End If
End Sub
Sub Arret()
    BoolStart = False
    Application.OnTime Now + TimeValue("00:00:01"), "nexttick", False
End Sub
Sub Reinit()
    'Reaffectation de la valeur du compteur au temps alloué à la feuille
    Dim oShape As Shape
    Dim oCellTempsAlloue As Range
    Dim dCompteur As Date

    Set oShape = ActiveSheet.Shapes("Compteur")
    Set oCellTempsAlloue = ActiveSheet.Names("TempsAlloue").RefersToRange
    dCompteur = oCellTempsAlloue.Value
    oShape.OLEFormat.Object.Caption = Format(dCompteur, "hh:nn:ss")
End Sub

Je joins mon classeur de test.

12tirages-7-lettres-ods-8-uniq-jeux-interactifs-lr-gvs.xlsm (235.39 Ko)
Le 27/10/2019 à 10:19

Bonjour Gérard !

Merci pour votre aide précieuse.

Pour avoir bien compris, je tiens à reformuler partie par partie, ce que vous m'avez suggérer de faire...

Si j'ai bien compris, une des étapes, c'est de supprimer les boutons "marche2", "arret2" (etc. etc. pour les numéros suivants), et d'y insérer à la place des boutons de formulaire en y affectant les mêmes macros que sur la feuille de test ? Et les nommer de la manière suivante "marche" et "arret"', cette fois ci, sans les numéroter...? Et rajouter un bouton "réinitialisation" en plus des deux, et affecter cette macro là?

Merci!

Belle journée

Lucrob

Rechercher des sujets similaires à "compte rebours chaque feuille"