Compte à rebours

Retour vers Excel

But : Obtenir un formulaire qui se ferme automatiquement après un certain délai en secondes

On utilise un formulaire avec 2 étiquettes, un moyen pour afficher le formulaire. On peut bien entendu personnaliser le message affiché sur le formulaire, comme par exemple "Impression en cours"
On peut aussi modifier la durée d'affichage

1. Sur la feuille, le code suivant (2 manières de faire, une seule suffit évidemment - avec un bouton - double clic dans la cellule G3)

Private Sub CommandButton1_Click()
    UserForm1.Show 'affiche le formulaire
End Sub
'************************* ou bien *******************
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Target.Address = "$G$3" Then 'on vérifie si on entre dans la bonne cellule
UserForm1.Show 'affiche le formulaire
End If
End Sub

2. Dans le code du formulaire

Private Sub UserForm_Activate()
    Compteur = 0 'réinitialisation
    Call Decompter 'on lance le compte à rebours
End Sub

3. Dans un module


Public Compteur As Integer
Public Tps As Date

Sub Decompter()
If Compteur < 15 Then
    UserForm1.Label1 = 15 - Compteur
    Compteur = Compteur + 1
    DoEvents
    Tps = Now + TimeValue("00:00:01")
    Application.OnTime Tps, "Decompter", , True
    
Else
    Unload UserForm1
    On Error Resume Next
    'Stopper la gestion de l'évènement OnTime en cours
    Application.OnTime Tps, "Decompter", , False
    
End If
End Sub

Télécharger le fichier

Fin