Faire un compte à rebours sur chaque feuille
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
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 ?
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
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.
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