Compte à rebours dans Userform Résolu/Fermé

Question

Bonjour,
Je suis coincé avec un petit bug.
Je veux que mon fichier, s'il reste inactif pendant 15 minutes un userform s'affiche et inscrit un compte à rebours de 30 secondes avant fermeture avec un bouton 'Annuler' qui permettrait de continuer à travailler sur ce fichier.
Présentement j'ai un début pas si mal mais je n'arrive pas à Cancellé sur 
userform, La commande fermeture continue quand même;

'Dans Workbook

Private Sub Workbook_Open()
    StartTimer
End Sub

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
    ReiniTimer
End Sub


'Dans Module
Dim HeureProgrammer As Double

Public Sub FermetureAuto()
    ActiveWorkbook.Close SaveChanges:=True
    'sauvegarde et ferme
    
End Sub

Sub StartTimer()
    'Lance le timer une première fois
    HeureProgrammer = Now + TimeValue("00:15:00")
    Application.OnTime HeureProgrammer, "ExecutionTimer"
End Sub

Public Sub ExecutionTimer()
    'Place ici le code à effectuer
UserForm2.Show
    
End Sub

Public Sub ReiniTimer()
    'Arrete le timer
    Application.OnTime EarliestTime:=HeureProgrammer, Procedure:="ExecutionTimer", Schedule:=False

    'Le relance avec une nouvelle heure
    HeureProgrammer = Now + TimeValue("00:15:00")
    Application.OnTime HeureProgrammer, "ExecutionTimer"
End Sub

'Dans Userform2

Private Sub UserForm_Activate()
 For i = 30 To -1 Step -1
 If Application.Wait(Now + TimeValue("00:00:01")) Then
     DoEvents
     Label4.Caption = i & " Sec"
   End If
 Next
 Unload Me
 Call FermetureAuto
 End Sub

Sub CommandButton1_Click() 'annuler

 Unload Me

End Sub

svp aidez-moi

Mike-31 · Answer

Bonsoir,

Je connais ce code, mais pourquoi mettre un bouton annuler, il suffit d'avoir une activité sur le fichier comme un simple déplacement de la cellule active et la procédure recommence pour 15 minutes d'attente puis le compte à rebours.
A moins que le bouton annuler sorte de la procédure
Il se fait tard pour moi je regarde demain en fonction de ta réponse
A+
Mike-31

Une période d'échec est un moment rêvé pour semer les graines du savoir.

Mike-31 · Answer

Re,

Regarde ce fichier, pour des raison de rapidité de test le décompte d'attente est de 2 minutes avant avertissement et délai avant fermeture est de 60 secondes.
à l'apparition  de l'UserForm, il suffit d'avoir une activité sur le fichier comme déplacer la cellule active pour relancer la procédure d'attente.
Dès que j'ai un moment je remplace le Label de l'UserForm par un compte à rebours
	https://www.cjoint.com/c/EBykOt7NHzT

Mike-31 · Answer

Re,
Le Beep c'est un son pour attirer l'attention que tu peux virer si tu ne le souhaite pas

je regarde le compte à rebours

Mike-31 · Answer

Re,

j'ai écrit plusieurs codes mais le timer compte à rebours que l'on place sur l'userform rentre en conflit avec celui de la fermeture du fichier en cas d'inactivité.
je ne vois pas comment le contourner, dès que j'ai un peu de temps je me penche sur ce problème pertinent qui peux en intéresser plus d'un

Mike-31 · Answer

Re,

J'ai écrit un code qui semble tenir la route, je te le livre brut pour tester, je ferai le ménage demain.
la msgbox  à l'ouverture du fichier peut être supprimée si tu la juges inutile.
 les durées sont réduite pour permettre des tests rapides
 https://www.cjoint.com/c/EBzx1D0o2Kw 
A+
Mike-31

Une période d'échec est un moment rêvé pour semer les graines du savoir.

Mike-31 · Answer

Re,

j'ai commencé à revoir le code, en début de code dans le module j'ai ajouté des constantes pour adapter au besoin les différentes action du code que tu peux modifier

Const Veille As Variant = "00:05:00" 
Const Rebours As Variant = "60" 
Const Alert As Variant = "10" 

j'ai également ajouté une alerte sonore Beep que je peux faire varier crescendo pour avoir une alerte sonore discrète au début

	https://www.cjoint.com/c/EBAlFgFZw8T

Mike-31 · Answer

Re,

voila le fichier avec un code en clair et annoté 
https://www.cjoint.com/c/EBAsrinrpOc

Mike-31 · Answer

Re,

Que ce passe t il, tu décroches !

si le sujet est toujours d'actualité après plusieurs essais dans des conditions peu commune, j'ajouterais un bouton sur l'userform, mais bon j'attends ton retour

Mike-31 · Answer

Re,

C'est tout !
 plus de nouvelle, dommage que cette discussion pertinente ne soit pas prolongée.
Confirme nous qu'en ce qui te concerne tes attentes sont satisfaites afin de mettre le statut de la discussion en résolu et puisse servir de référence

July74 · Answer

Je suis désolé !
Je n'avait pas quitté seulement j'ai dû m'absenter pendant plusieurs jours,
De retour, je regarde ce que j'ai manqué!

Mike-31 · Answer

Re,

merci du retour, comme je te l'ai dit, ta demande est pertinente ce qui m'a motivé et donc ma poussé a tester le fichier dans moultes utilisations 
et si l'utilisateur du fichier travaille sur plusieurs fichiers en même temps il lui sera difficile d'arrêter la procédure de fermeture automatique en revenant sur le fichier.
Comme l'Userform s'ouvre toujours en premier plan, j'ai donc ajouter trois boutons sur l'userform 
1 bouton pour relancer le délai avant fermeture sans revenir sur le fichier
1 deuxième bouton pour revenir sur le fichier et relancer le délai de fermeture
et 1 pour forcer la fermeture du fichier

https://www.cjoint.com/c/ECgs3naiiDx

July74 · Answer

Tout ce travail!
Merci pour moi et pour les autres dans ma branche de débutant qui veulent apprendre.
Très bien fait avec tes explications c'est super claire.

Peut-être suis-je trop ignorante, trop débutante, j'ai quelque question pour bien comprendre le code, 
Allons-y une à la fois si tu veux bien m'aider?

Dans le code suivant;
Sub Minuterie(Sec As Single)' ------------------- Lance le timer du compte à rebours    Dim Arret As Single    On Error Resume Next    Arret = Timer + Sec    Do While Timer < Arret    DoEvents    Loop    On Error GoTo 0End Sub

Je ne comprends pas d'où vient Timer & Sec 
Sec est une variable, tu l'as déterminé "As Single" 
Sec est déterminé comment?
Timer est quoi? pas une macro ou une variable car Il y en a pas ailleurs dans le code. 
Est-ce une commande vba ?

Mike-31 · Answer

Re,

C'est pour reprendre le cadencé du processeur (de l'horloge interne) ce code m'a permis de l'intégré dans le code juste au dessous "Decompte(Optional i As Integer = 15)" 
et d'adapter la vitesse du décompte avec l'affichage sur l'userform.

 ce qui m'a permis d'utiliser deux fois le Timer, une fois "StartTimer" pour la programmation du décompte avant fermeture et à l'intérieur de ce décompte ajouter un décompte sur l'userform 

dans ce code "Sub Decompte(Optional i As Integer = 15)"

tu trouveras Minuterie 1
si a Minuterie je mets 2 le décompte visuel sur l'userform sera de seconde en seconde mais le changement sera de 2 secondes en 2 secondes et si je mets Minuterie 3 l'affichage visuel sera de seconde en seconde mais le changement sera lent de 3 secondes

Fait un essai à Minuterie 3 et lance la procédure en déplaçant ta souris et laisse faire jusqu'à l'apparition de l'userform et observe
 C'est le même code que "StartTimer" 
avec Attente = Now + TimeValue(Veille)


A+
Mike-31

Une période d'échec est un moment rêvé pour semer les graines du savoir.

July74 · Answer

Ok,
Donc le temps de la minuterie n'est pas nécessairement, dans ce cas-ci, 60 Secondes, dépendant si tu met Minuterie 1 oui mais ex Minuterie 2 le décompte 60-59-58... prendra le double du temps réel ?

Mike-31 · Answer

Re,

voila oui tout à fait

July74 · Answer

Bon je viens de testé ton dernier fichier envoyé avec les boutons ajoutés dans  Userform, c'est une très bonne observation, je n'avais pas eu l'occasion dans l'utilisation que j'en ai fait jusqu'à maintenant d'être sur un autre fichier en même temps.
c'est bien merci beaucoup!

Mike-31 · Answer

Re,

Si à l'usage tu remarquais un dysfonctionnement du fichier, reviens sur la discussion ou envoie moi un message privé avec tes remarques, ce fichier mérite d'être perfectionné même si ce type de demande est rare.
Cordialement

Compte à rebours dans Userform

17 réponses

Discussions similaires