Compte à rebours apparent

'### Constantes à adapter ###
Const DUREE As Long = 30                    'durée en secondes
Const PREFIXE As String = "Temps restant "  'préfixe qui s'inscrit dans la Barre d'état
'############################

Private Debut As Date
Private Fin As Date

Sub CompteRebours()
Dim Etat As Boolean
Etat = Application.DisplayStatusBar
If Not Etat Then Application.DisplayStatusBar = True
Debut = Time
Fin = Debut + DUREE / 86400
Application.StatusBar = PREFIXE & Format(Fin - Time, "hh:mm:ss")
Call Rebours
Application.StatusBar = False
Application.DisplayStatusBar = Etat
MsgBox "Terminé"

  '--- Insérez votre traitement STOP ---
  
End Sub

Sub Rebours(Optional dummy As Byte)
Dim Pause As Long
Dim Start As Date
Dim A$
On Error GoTo Erreur
Pause = 1
Start = Timer
Do While Timer < Start + Pause
  DoEvents
Loop
If Fin - Time <= 0 Then
  Error 65535
End If
A$ = Format(Fin - Time, "hh:mm:ss")
If Application.StatusBar <> PREFIXE & A$ Then
  Application.StatusBar = PREFIXE & A$
  If CLng(Format(A$, "hhmmss")) <= 10 Then Beep
End If
Call Rebours 'appel récursif
Exit Sub
'--- Pseudo traitement d'erreur ---
Erreur:
End Sub