Compte à rebours

Bonjour au forum,

J'ai du mal à intégrer dans ce code (qui ferme mon fichier après quelques secondes d'inactivité) un compte à rebours défilant dans une MsgBox.

L'objectif est que si l'utilisateur clique sur "Annuler", le fichier reprendrait le compte à rebours au début, et si pas de clique, fermeture du fichier.

Voici mon code :

Option Explicit
Option Private Module
Dim Ws As Worksheet
Const Delai = 10

Sub Programmation()
Dim Heure As Date
  Heure = Now + TimeValue("00:00:" & Delai)
  ThisWorkbook.Names.Add Name:="ChronoTime", RefersTo:=Heure
  ThisWorkbook.Names.Add Name:="Chrono", RefersTo:=0
  Application.OnTime Heure, "Interruption"
End Sub

Private Sub Interruption()
  With ThisWorkbook
    If .Sheets(1).Evaluate("Chrono") = 0 Then
        Fermeture
    Else
        Programmation
    End If
  End With
End Sub

Sub SupprimeInterruption()
Dim Heure As Date
 On Error Resume Next
Heure = ThisWorkbook.Sheets(1).Evaluate("ChronoTime")
Application.OnTime Heure, "Interruption", schedule:=False
End Sub

Sub Fermeture()

'Application.Run ("coller_on")
'Application.Run ("RéactiverCtrlCV")

Application.ScreenUpdating = False

Sheets("Accueil").Visible = xlSheetVisible

For Each Ws In ThisWorkbook.Worksheets
    If Ws.Name <> "Accueil" Then Ws.Visible = xlSheetVeryHidden
Next Ws

Application.ScreenUpdating = True

'backup iphone

SupprimeInterruption

ThisWorkbook.Save
Application.Quit

End Sub

Auriez-Vous une idée ?

Merci d'avance pour votre aide !

Bonjour,

Je n'ai pas cherché à adapter ton code, j'en ai fais un qui me semble plus simple avec le décompte en cellule A1 :

Sub Demarrer()

    Decompte 10 'ici, 10 minutes

End Sub

Sub Decompte(Valeur As Integer)

    'le décompte en A1
    Range("A1").Value = Valeur & " minutes restantes !"

    If Valeur = 0 Then GoTo Fin 'saute le rappel une fois le décompte fini

    'pour tester en secondes
    'Application.OnTime Now + TimeValue("00:00:01"), "'Decompte " & Valeur - 1 & "'"

    Application.OnTime Now + TimeValue("00:01:00"), "'Decompte " & Valeur - 1 & "'"

    Exit Sub
Fin:

    Fin

End Sub

Sub Fin()

    'ici, ton code de fin...
    '...
    '...

    MsgBox "C'est fini !"

End Sub

Bonjour Theze,

Merci pour ta proposition !

Je viens à l'instant de trouver une solution en passant par un UserForm

Si le code intéresse quelqu'un qui passe par là, je pourrais le mettre à disposition une fois que je l'aurai légèrement optimisé...

Excellente semaine au forum et merci encore Theze pour avoir pris de ton temps pour me répondre !