Compte à rebours - Quitter et sauvegarder

[leop93]

Bonjour ami(e)s XLDériens !

Je suis en train de modifier le très bon compte à rebours que j'ai trouvé sur un forum (je ne sais plus si c'était celui-ci ou un autre) et j'en remercie l'auteur.

Mais je me retrouve face à un problème de taille pour moi, mais qui peut être peut sembler évident pour un habitué de Excel.

Le voici:

J'arrive à lancer mon compte à rebours après un temps T pour une durée t. Une fois que le compte à rebours est terminé, si l'utilisateur ne l'a pas quitté, j'aimerais qu'il sauvegarde toutes les feuilles du classeur et qu'il le quitte.

Voici le code dont je me sers:

Sub saveAndQuit(Cancel As Boolean)
Dim w As Worksheet
For Each w In Application.Workbooks
w.Save
Next w
Application.Quit
End Sub

Mais je me retrouve avec une erreur "Membre de méthode ou de données introuvable" sur la ligne "w.Save". Alors que cette même ligne fonctionne dans un autre classeur que j'ai préparé. Quelqu'un saurait il comment solutionner ceci ?

Une autre question, je n'ai jamais fait d'UserForm jusqu'à maintenant, comment faut il s'y prendre pour ajouter des boutons avec des actions (un pour annuler le compte à rebours et un autre pour dire qu'il peut quitter et sauvegarder avant la fin du même compte à rebours) ?

Bonne journée et merci d'avance pour votre aide

Leop93

 

[leop93]

Re : Compte à rebours - Quitter et sauvegarder

D'avance pardon pour ce double post, mais j'ai trouvé pourquoi j'avais cette erreur... J'ai simplement remis la macro saveAndQuit(Cancel as Boolean) dans ThisWorkbook au lieu du Module et je l'ai appelé de cette manière "Call ThisWorkbook.saveAndQuite(False) et ça fonctionne. Je poste ceci en espérant que ça aide quelqu'un qui aura le même "soucis".

La deuxième partie de ma question est toujours d'actualité (création des boutons d'actions).

 

[mephis]

Re : Compte à rebours - Quitter et sauvegarder

Bonjour, dis moi si ça te convient

 

[leop93]

Re : Compte à rebours - Quitter et sauvegarder

Salut Mephis

C'est pas mal, mais j'aurais préféré sur l'Userform d'origine.

D'ailleurs j'ai réussi à le faire. J'avais un soucis car je n'arrivais pas à activer la boite à outils dans l'Userform déjà en place, donc j'ai du en créer un second pour pouvoir faire un bouton de commande et le copier/coller sur mon Userform du compte à rebours.

Si j'avais cherché un petit peu plus avant de poser ces questions, je ne vous aurais pas embêté.

Je vous joint mon compte à rebours complet, si ça peut aider du monde.

Bonne fin de matinée

Leop93

EDIT: et si vous souhaitez que le compte à rebours se relance toutes les 5 minutes par exemple, ajoutez ceci entre le "End If" et le "End Sub" du Module:

Application.OnTime _
            EarliestTime:=Now + TimeValue("00:05:00"), _
            Procedure:="ExecutionTimer", _
            Schedule:=True

 

[leop93]

Re : Compte à rebours - Quitter et sauvegarder

Me re-voilà !

Si jamais quelqu'un sait pourquoi, mon compte à rebours se relance parfois directement après l'avoir annulé (il faut l'annuler plusieurs fois pour qu'il ne se relance qu'après les 5 minutes programmées). Par contre, ce soucis est complètement aléatoire.

Voici le code:

Option Explicit
Public Lheure As Date
Public Dheure As Date

Sub ArretTimer()
On Error Resume Next
Application.OnTime Lheure, "ExecutionTimer", , False
End Sub

Sub ExecutionTimer()
Load UserForm1
UserForm1.Show 0

UserForm1.Label1.Caption = Format(Dheure - Now(), "hh: mm: ss ")
If Dheure - Now() > 0 Then
Lheure = Now() + TimeSerial(0, 0, 1)
Application.OnTime Lheure, "ExecutionTimer"
Else
ArretTimer
UserForm1.Label1.Caption = "Au revoir"
Application.Wait (Now + TimeValue("00:00:01"))
Call ThisWorkbook.saveAndQuit(False)
End If
Application.OnTime _
            EarliestTime:=Now + TimeValue("00:05:00"), _
            Procedure:="ExecutionTimer", _
            Schedule:=True
End Sub

Leop93

 

[MJ13]

Re : Compte à rebours - Quitter et sauvegarder

Bonjour Leop, Mephis

Le plus important avec Ontime, c'est en cas d'annulation de bien penser à mettre le Schedule:=false en indiquant la bonne date de fin qui doit être la même que celle définit auparavant.

 

[leop93]

Re : Compte à rebours - Quitter et sauvegarder

C'est à dire que je dois juste modifier mon Schedule:=True en Schedule:=False à la fin de mon code ?

Ce qui est bizarre, c'est que mon compte à rebours n'a pas reposé de problème depuis l'heure d'envoi de mon dernier message... Vraiment aléatoire...

 

[MJ13]

Re : Compte à rebours - Quitter et sauvegarder

Re

Ce que je voulais dire c'est que c'est assez sensible la programmation du Ontime.

Dans ton fichier, cela me paraît un peu complexe. Après cela dépend de ce que tu veux faire.

En plus,tu parles d'inactivité. Or, si je tape un texte, le message apparaît, donc ce n'est pas très au point. Pour voir si il y a inactivité, le mieux est de contrôler le nombre de caractères tapés dans le classeur.

 

[leop93]

Re : Compte à rebours - Quitter et sauvegarder

Oui au final, je ne souhaite plus vérifier l'inactivité mais afficher le message toutes les 5 minutes, ça sera plus simple et suffisant pour l'utilisation du fichier.

Ce que j'aimerais, c'est que:

- a l'ouverture du fichier rien ne se passe
- au bout de 5 minutes, le compte à rebours de 30 secondes apparaît
- si le compte à rebours atteint 0 le classeur est sauvegardé et fermé
- si l'utilisateur clique sur le bouton pour annuler, le compte à rebours est relancé 5 minutes plus tard

Et c'est tout je pense.

 

[MJ13]

Re : Compte à rebours - Quitter et sauvegarder

Re

Normalement, tu as maintenant tous les éléments pour y arriver.

Repart d'un projet vierge, et évite les trucs trop compliqués, vérifie tes variables publiques.

Bon courage .

 

[leop93]

Re : Compte à rebours - Quitter et sauvegarder

Ok, je vais essayer tout ça. Je n'ai rien modifié pour le moment et je n'ai plus de soucis, c'est vraiment spécial.

Je vais repartir d'un projet vierge pour voir si j'arrive à refaire ce compte à rebours.

Merci pour ton aide et les précisions sur la fonction Ontime.

 

[leop93]

Re : Compte à rebours - Quitter et sauvegarder

Je n'arrive pas à solutionner mon soucis... A la 3ème réapparition, il commence à s'afficher plusieurs fois au lieu d'une...