XL 2016 Code VBA enregistrement et compte à rebours

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

FRANCKSN

XLDnaute Nouveau
Bonjour à tous et très bonne année 2023,
J'aurai besoin d'un petit coup de pouce avec une macro que j'ai réalisée pour la fermeture automatique d'un fichier après un certain délai. J'ai inséré un chrono pour que les utilisateurs visualisent le temps qu'il leur reste mais je me heurte à 2soucis :
1 - Lors de la saisie le chrono s’arrête mais ne se recale pas à la reprise du compte à rebours, d’où un décalage à la fin avec le temps imparti. Ce que je souhaiterai c’est que le compte à rebours continue même en faisant une saisie sur le fichier.
2 - A la fin du décompte je souhaiterai alerter l’utilisateur que le fichier va se fermer et s’enregistrer au même emplacement.


Merci d’avance pour votre aide
Très belle journée à tous

Franck (En mission à Dakar)
 

Pièces jointes

Bonjour,
Houps un loupe, je reprend le fichier.
J'ai retrouve dans mon fatra deux fichiers
Un ou le decompte est temps reel meme en saisie, mais avec une Userform
L'autre le decompte dans une cellule est visible au depart, mais se fige sur saisie (incontournable) et reprend avec le bon decompte sur sortie cela cellule de saisie.
Que preferez vous?
 
Dernière édition:
Bonjour FRANCKSN, Oneida,

Voyez le fichier joint et le code dans ThisWorkbook :
VB:
Private Sub Workbook_Open()
Application.OnTime 1, Me.CodeName & ".Decompte" 'lance le processus
End Sub

Sub Decompte()
Dim delai#, cel As Range, t#
delai = 50 'en secondes
Set cel = [F3]
t = Timer + delai
On Error Resume Next
While Timer < t And t < 86400
    cel = (t - Timer) / 86400
    DoEvents
Wend
Me.Save
If Workbooks.Count = 1 Then Application.Quit Else Me.Close
End Sub
Une MsgBox n'est pas souhaitable car le fichier ne se fermera pas tant qu'elle restera affichée.

Il sera bon de protéger le VBAProject pour que l'utilisateur ne modifie pas le code.

A+
 

Pièces jointes

L'utilisateur peut arrêter le décompte en protégeant la feuille.

Pour l'éviter il suffit justement de protéger la feuille avec un mot de passe secret, ici "toto" :
VB:
Private Sub Workbook_Open()
Application.OnTime 1, Me.CodeName & ".Decompte" 'lance le processus
End Sub

Sub Decompte()
Dim delai#, cel As Range, t#
delai = 50 'en secondes
Set cel = [F3]
t = Timer + delai
ActiveSheet.Protect "toto", UserInterfaceOnly:=True 'mot de passe à adapter
On Error Resume Next
While Timer < t And t < 86400
    cel = (t - Timer) / 86400
    DoEvents
Wend
Me.Save
If Workbooks.Count = 1 Then Application.Quit Else Me.Close
End Sub
 

Pièces jointes

Bonjour,
Houps un loupe, je reprend le fichier.
J'ai retrouve dans mon fatra deux fichiers
Un ou le decompte est temps reel meme en saisie, mais avec une Userform
L'autre le decompte dans une cellule est visible au depart, mais se fige sur saisie (incontournable) et reprend avec le bon decompte sur sortie cela cellule de saisie.
Que preferez vous?
C'est parfait merci beaucoup

Franck
 
L'utilisateur peut arrêter le décompte en protégeant la feuille.

Pour l'éviter il suffit justement de protéger la feuille avec un mot de passe secret, ici "toto" :
VB:
Private Sub Workbook_Open()
Application.OnTime 1, Me.CodeName & ".Decompte" 'lance le processus
End Sub

Sub Decompte()
Dim delai#, cel As Range, t#
delai = 50 'en secondes
Set cel = [F3]
t = Timer + delai
ActiveSheet.Protect "toto", UserInterfaceOnly:=True 'mot de passe à adapter
On Error Resume Next
While Timer < t And t < 86400
    cel = (t - Timer) / 86400
    DoEvents
Wend
Me.Save
If Workbooks.Count = 1 Then Application.Quit Else Me.Close
End Sub
Bonjour,
Merci beaucoup por ton aide.

Franck
 
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

Réponses
15
Affichages
899
Réponses
2
Affichages
659
Réponses
3
Affichages
245
Réponses
24
Affichages
3 K
  • Question Question
Microsoft 365 Excel vba
Réponses
5
Affichages
493
Retour