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