XL 2016 Code VBA enregistrement et compte à rebours

[FRANCKSN]

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)

 

[Oneida]

Bonjour,
Doevents debut procedure Sub majHeure()

 

[FRANCKSN]

Bonjour Oneida,

Désolé je ne comprends pas ta réponse et le fichier que tu m'as retourné est identique...

Bonne journée

Franck

 

[Oneida]

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?

 

[job75]

Bonjour FRANCKSN, Oneida,

Voyez le fichier joint et le code dans ThisWorkbook :

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+

 

[job75]

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" :

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

 

[FRANCKSN]

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

 

[FRANCKSN]

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" :

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