Chronomètre en parralèlisme
Bonsoir à tous,
Je fais un jeu minuté en VBA.
Du coup j'ai implémenté un minuteur avec les fonctions Start, Stop et Reset (voir ci-dessous)
Le calcul de la solution étant complexe, cela prend environ 40 secs.
Pour ne pas attendre, j'aimerais pouvoir faire en sorte qu'il calcule en parralèle de l'égrenement du temps du minuteur.
Du coup dans la fonction Start, j'ai fais en sorte d'appeller la procédure de calcul du résultat (resultat_chiffre) au moment ou le minuteur affiche 1mn et 0 sec
Ca marche...pas complétement:
Au moment ou le minuteur affiche 1mn, il arrete d'afficher l'égrenement du temps, tant que la procédure de calcul est en cours. L'egrenement du temps continue bien en parralele, mais il ne recommence à l'afficher qu'une fois la procédure terminée.
Vous savez comment pouvoir faire en sorte que les deux se fassent en parallèle?
Merci.
Voici ci-dessous les procédures du minuteur:
Sub START_TIMER()
If Cells(7, 100) = "Stopped" Then
s = "00:" & Format(Cells(4, 100), "00") & ":" & Format(Cells(5, 100), "00")
Else
s = "00:" & Format(Cells(1, 100), "00") & ":" & Format(Cells(2, 100), "00")
End If
Cells(7, 100) = "Started"
EndTime = Now + TimeValue(s)
Cells(12, 4) = s
x:
VBA.DoEvents
If Cells(7, 100) = "Stopped" Then Exit Sub
CurrentTime = Now
Diffm = Int(DateDiff("s", CurrentTime, EndTime) / 60)
diffs = DateDiff("s", CurrentTime, EndTime) - Diffm * 60
Cells(4, 100) = Diffm
Cells(5, 100) = diffs
s = "00:" & Format(Diffm, "00") & ":" & Format(diffs, "00")
Cells(12, 4) = s
If Diffm = 1 And diffs = 0 Then
Call resultat_chiffre
End If
If Diffm = 0 Then
If diffs = 5 Then
Cells(12, 4).Interior.ColorIndex = 3
Cells(12, 4).Font.ColorIndex = 2
ElseIf diffs = 15 Then
Cells(12, 4).Interior.ColorIndex = 46
Cells(12, 4).Font.ColorIndex = 2
End If
If diffs = 30 Then
Application.Speech.Speak "30 secondes restantes!"
ElseIf diffs = 15 Then
Application.Speech.Speak "15 secondes restantes!"
ElseIf diffs = 13 Then
Beep 400, 490
ElseIf diffs = 11 Then
Beep 400, 490
ElseIf diffs = 9 Then
Beep 400, 490
ElseIf diffs = 7 Then
Beep 400, 490
ElseIf diffs < 5 Then
Beep 550, 150
ElseIf diffs = 0 Then
Application.Speech.Speak "Terminé"
End If
If diffs = 0 Then
Cells(7, 100) = "Stopped"
Exit Sub
End If
End If
GoTo x
End Sub
Sub STOP_TIMER()
Cells(7, 100) = "Stopped"
End Sub
Sub RESET_TIMER()
Cells(7, 100) = "Over"
s = "00:" & Format(Cells(1, 100), "00") & ":" & Format(Cells(2, 100), "00")
Cells(12, 4) = s
Cells(12, 4).Interior.ColorIndex = 2
Cells(12, 4).Font.ColorIndex = 1
End Sub
Bonjour,
pour ça il faut faire ton chrono en utilisant OnTime (voir l'aide dessus)
Tu le programmes pour qu'il s'appelle lui même toute les secondes pour rafraichir le temps indiqué.
Tu dois mémoriser l'heure prévue d'appel pour pouvoir annuler cet appel :
(Application.OnTime EarliestTime:=m_nextTime, Procedure:="nom_de_ta_proc_timer",
Schedule:=False)
m_nextTime : heure d'appel mémorisée
lors de l'arrêt du chrono, ET lors de la fermeture du fichier (Workbook_BeforeClose)
Et dans un boucle de ton autre calcul tu insères un DoEvent.
eric