Plusieurs Timer Excel qui se ferme et qui redémarre

AzoR

XLDnaute Occasionnel
Hello tout le monde !
Voici mon probleme :
Pour le travail je souhaite créer un excel afin de me faciliter la tache, je m'explique.
Je test plusieurs appareils, ici des fours, et je réalise plusieurs essais de cuisson avec ou sans préchauffage etc …
L'idée et d'avoir un affichage simplifié en rentrant le temps minimum de cuisson, on lance un chrono sur excel, et 5 minutes avant la fin du temps de cuisson minimum, la case apparait en orange par exemple avec une alarme sonore, de même avec tous les fours sous forme de liste, et ainsi que sur une seconde page tous les fours soit classés par ordre de fin, afin de savoir quel four a bientôt fini sa cuisson et ne pas être obligé de faire le tour de tous les chrono accroché aux fours pour savoir qui aura bientôt fini etc …
Mon programme fonctionne très bien pour un four, couleur de la case, son etc tout fonctionne … or dès que je mets 2 ou 3 timer simultanément excel crash et redémarre. Je pense que je dois aborder le problème des timer différemment mais je ne vois pas du tout comment je pourrais faire …
Je vous mets en pièce jointe mon fichier excel entier (en second message dans cette discussion) afin que ce soit plus simple pour vous de comprendre ^^
Je joins aussi des photos afin que vous puissiez voir facilement l'idée générale de l'aspect du fichier excel que je souhaite obtenir.

Voici le code correspond aux boutons de mon four 1 (que j'ai ensuite simplement copier pour le four 2, 3, 4 etc...) :


Sub CommandButton1A_Click() 'bouton START
Dim StartTime1, FinishTime1, TotalTime1, PauseTime1, Debut1
StopIt1 = False
ResetIt1 = False
Range("J3") = Timer
X = 0
If Range("H3") = 0 Then
StartTime1 = Timer
PauseTime1 = 0
LastTime1 = 0
Else
StartTime1 = 0
PauseTime1 = Timer
End If
StartIt1:
DoEvents
If StopIt1 = True Then
LastTime1 = TotalTime1
Exit Sub
Else
FinishTime1 = Timer
TotalTime1 = FinishTime1 - StartTime1 + LastTime1 - PauseTime1
TTIME1 = TotalTime1 * 100
HM1 = TTIME1 Mod 100
TTIME1 = TTIME1 \ 100
hh1 = TTIME1 \ 3600
TTIME1 = TTIME1 Mod 3600
MM1 = TTIME1 \ 60
SS1 = TTIME1 Mod 60
Range("H3").Value = Format(hh1, "00") & ":" & Format(MM1, "00") & ":" & Format(SS1, "00") & "." & Format(HM1, "00")


TPSREST1 = (Range("J3") + Range("K3") + (Range("D3") * 60)) - Timer
HRErest1 = TPSREST1 \ 3600
TPSREST1 = TPSREST1 Mod 3600
MMrest1 = TPSREST1 \ 60
SSrest1 = TPSREST1 Mod 60
Range("L3") = TPSREST1
Range("I3").Value = Format(HRErest1, "00") & ":" & Format(MMrest1, "00") & ":" & Format(SSrest1, "00")

If Range("L3").Value > 15 Then
Range("I3").Interior.ColorIndex = 4
Else
If Range("L3").Value <= 15 And Range("L3").Value > 0 Then
Range("I3").Interior.ColorIndex = 46

If IsEmpty(test1) Then
PlaySound "C:\Programme ICRT\alarme.WAV", 0, 0
test1 = 1
End If

Else
If Range("L3").Value <= 0 Then
Range("I3").Interior.ColorIndex = 3
If IsEmpty(test2) Then
PlaySound "C:\Programme ICRT\alarme.WAV", 0, 0
test2 = 1
End If
End If
End If
End If
X = X + 1
If X = 3500 Then
Call FILTRE
X = 0
Else
End If

GoTo StartIt1

End If

End Sub
--------------------------------------------------------------------------------
Sub CommandButton1D_Click() 'temps pr?chauffage
TTIME1 = (Timer - Range("J3"))

HRE1 = TTIME1 \ 3600
TTIME1 = TTIME1 Mod 3600
MM1 = TTIME1 \ 60
SS1 = TTIME1 Mod 60
Range("C3").Value = Format(HRE1, "00") & ":" & Format(MM1, "00") & ":" & Format(SS1, "00")

Range("K3") = TTIME1

End Sub
--------------------------------------------------------------------------------
Sub CommandButton1C_Click() 'bouton RESET

Range("H3") = Format(0, "00") & ":" & Format(0, "00") & ":" & Format(0, "00") & "." & Format(0, "00") 'mise ? z?ro cellule Timer
Range("C3") = Format(0, "00") & ":" & Format(0, "00") & ":" & Format(0, "00") 'mise ? z?ro cellule Temps de pr?chauffage (min)
Range("J3") = 0
Range("K3") = 0
Range("I3") = 0
Range("L3") = 0
End Sub
Sub CommandButton1B_Click() 'bouton STOP
End
End Sub
--------------------------------------------------------------------------------
Sub FILTRE() ' FILTRE Macro

ActiveWorkbook.Worksheets("SYNTHESE").AutoFilter.Sort.SortFields.Clear
ActiveWorkbook.Worksheets("SYNTHESE").AutoFilter.Sort.SortFields.Add Key:= _
Range("G2:G26"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortNormal
With ActiveWorkbook.Worksheets("SYNTHESE").AutoFilter.Sort
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
End Sub








Merci d'avance pour votre aide !!! ;)
 
Dernière édition:

Discussions similaires

Réponses
1
Affichages
160
Réponses
6
Affichages
227
Réponses
17
Affichages
926

Membres actuellement en ligne

Aucun membre en ligne actuellement.

Statistiques des forums

Discussions
312 086
Messages
2 085 197
Membres
102 814
dernier inscrit
JLGalley