Microsoft 365 TIMER (comptage ou décomptage) à l'ouverture du classeur

[Michest94]

Bonjour à tous,

Je sollicite votre aide pour la réalisation d'un compteur (timer) soit en mode comptage 00:00:01 ... ou bien décomptage 00:04:59 ... qui se déclenche à l'ouverture du classeur ouvert et qui fermera automatiquement le classeur par rapport au temps de paramétrage du timer. (exemple 5mn)

Ceci est lié au partage d'un classeur sur un serveur et parfois le fichier ouvert n'est pas refermé et donc impossible à utiliser pour les autres utilisateurs.

Un visuel du timer serait un plus avec éventuellement un avertissement de fermeture 1mn avant la fin du temps programmé.(exemple une couleur)


Merci à vous,

 

[mapomme]

Bonjour @Michest ,

J'avais commis ce fichier il y a quelque temps.

A adapter à votre cas. Ça devrait être plus simple puisque vous fermez le classeur.
Attention! Il faut se poser la question à la fermeturedu classeur: Doit-on ou non sauvegarder le fichier si le fichier a été modifié ?

Voir ici: Re : Copie de sauvegarde automatique avec timer

 

[Michest94]

Merci pour le retour,

En fait le fichier proposé ne correspond pas vraiment à ma demande celui ci fait une copie automatique au bout d'un temps définis alors que j'aurais voulu pouvoir fermé le classeur au bout du temps définis.
Ceci dit le fichier proposé je vais voir pour l'utilisé sur d'autre fichier me permettant d'avoir une synchro de sauvegarde pour réalisé un backup.

Merci quand même pour votre aide.

 

[sylvanu]

Bonjour Michest,
un essai en PJ avec dans Thisworkbook :

Sub Workbook_Open()
    TempsRestant = 30   ' Init du temps en secondes. Ici 30s pour test. Mettre 300 pour 5min.
    Compteur
End Sub
'Pour stoper à la fermeture du classeur
Sub Workbook_BeforeClose(Cancel As Boolean)
    Application.OnTime Now, "Compteur", schedule:=False     ' stoppe le compteur
    EcrireStatus (0)
    ActiveWorkbook.Close Savechanges:=False                 ' ferme sans enregistrer, sinon mettre True pour enregistrer
End Sub

et en module :

Public TempsRestant%
Sub Compteur()
    TempsRestant = TempsRestant - 1
    If TempsRestant = 0 Then
        EcrireStatus (0)
        ActiveWorkbook.Close Savechanges:=False ' ferme le fichier sans l'enregistrer, sinon mettre True pour l'enregistrement
        ' Application.Quit                      ' si pas en commentaires alors on sort d' XL
    End If
    EcrireStatus (1)
    clock
End Sub
Sub clock()
    Application.OnTime Now + TimeValue("00:00:01"), "Compteur"
End Sub
Sub EcrireStatus(N)
    If N = 1 Then
        Application.StatusBar = "Ce fichier va se fermer dans " & TempsRestant & " secondes. (  " & Format(TempsRestant / 86400, "hh:mm:ss") & "  )"
    Else
        Application.StatusBar = "  "                              ' vide le statusbar
    End If
End Sub

Dans la PJ le temps avant fermeture est de 30s pour test, le modifier pour le temps désiré.
J'utilise le statusbar pour l'affichage, évite de toucher aux feuilles.

 

[job75]

Bonjour Michest, mapomme, sylvanu, le forum,

alors que j'aurais voulu pouvoir fermé le classeur au bout du temps définis.

Alors c'est très simple, placez dans ThisWorkbook :

Private Sub Workbook_Open()
Application.OnTime Now + TimeValue("00:05:00"), Me.CodeName & ".Fermer"
End Sub

Private Sub Fermer()
Me.Save 'enregistre les modifications
If Workbooks.Count = 1 Then Application.Quit Else Me.Close
End Sub

et enregistrez le fichier en .xlsm.

Le classeur sera fermé 5 minutes après son ouverture.

A+

 

[job75]

Complément pour le cas où le fichier s'ouvre en lecture seule (fichier partagé) :

Private Sub Workbook_Open()
Application.OnTime Now + TimeValue("00:05:00"), Me.CodeName & ".Fermer"
End Sub

Private Sub Fermer()
If Me.ReadOnly Then Me.Saved = True Else Me.Save 'en lecture seule pas d'enregistrement
If Workbooks.Count = 1 Then Application.Quit Else Me.Close
End Sub

 

[Michest94]

Bonjour Michest,
un essai en PJ avec dans Thisworkbook :

Sub Workbook_Open()
    TempsRestant = 30   ' Init du temps en secondes. Ici 30s pour test. Mettre 300 pour 5min.
    Compteur
End Sub
'Pour stoper à la fermeture du classeur
Sub Workbook_BeforeClose(Cancel As Boolean)
    Application.OnTime Now, "Compteur", schedule:=False     ' stoppe le compteur
    EcrireStatus (0)
    ActiveWorkbook.Close Savechanges:=False                 ' ferme sans enregistrer, sinon mettre True pour enregistrer
End Sub

et en module :

Public TempsRestant%
Sub Compteur()
    TempsRestant = TempsRestant - 1
    If TempsRestant = 0 Then
        EcrireStatus (0)
        ActiveWorkbook.Close Savechanges:=False ' ferme le fichier sans l'enregistrer, sinon mettre True pour l'enregistrement
        ' Application.Quit                      ' si pas en commentaires alors on sort d' XL
    End If
    EcrireStatus (1)
    clock
End Sub
Sub clock()
    Application.OnTime Now + TimeValue("00:00:01"), "Compteur"
End Sub
Sub EcrireStatus(N)
    If N = 1 Then
        Application.StatusBar = "Ce fichier va se fermer dans " & TempsRestant & " secondes. (  " & Format(TempsRestant / 86400, "hh:mm:ss") & "  )"
    Else
        Application.StatusBar = "  "                              ' vide le statusbar
    End If
End Sub

Dans la PJ le temps avant fermeture est de 30s pour test, le modifier pour le temps désiré.
J'utilise le statusbar pour l'affichage, évite de toucher aux feuilles.

Bonjour Michest, mapomme, sylvanu, le forum,

Alors c'est très simple, placez dans ThisWorkbook :

Private Sub Workbook_Open()
Application.OnTime Now + TimeValue("00:05:00"), Me.CodeName & ".Fermer"
End Sub

Private Sub Fermer()
Me.Save 'enregistre les modifications
If Workbooks.Count = 1 Then Application.Quit Else Close
End Sub

et enregistrez le fichier en .xlsm.

Le classeur sera fermé 5 minutes après son ouverture.

A+

Merci pour le retour
Tester cela fonctionne bien peut on afficher le décompte dans le status bar?

 

[sylvanu]

Re,
Oups! Pas vu.
Rectifié en PJ.

 

[patricktoulon]

bonjour
tiens pour le fun
une mise a jour dans la barre de status tout les 5 secondes
elle te donne l'heure d'ouverture le temps qui c'est écoulé depuis l'ouverture et le temps qui te reste a 1 minute de la fin le message dans dans la statusbar est explicite
arrivé a zero la sub fermeture est déclenchée
a tester dans un classeur vierge avant d'implanter le code dans ton fichier

Dim timerstart
Const durée_max As String = "00:05:00" 'Adapter la durée souhaitée
Private Sub Workbook_Open()
    timerstart = TimeValue(Now)
    lookinstatusbar
End Sub

Sub lookinstatusbar()
    Dim heure1, x, y
    heure1 = TimeValue(Now)
    x = Application.Text(heure1 - timerstart, "[hh]:mm:ss")
    minute_max = TimeValue(durée_max)
    y = TimeValue(Application.Text(minute_max - TimeValue(x), "[hh]:mm:ss"))
    If TimeValue(y) < TimeValue("00:01:01") Then mess = "  Attention fermeture dans moins d'une minute !!!": Beep Else mess = "  il reste plus que :  "
    If y = 0 Then fermeture: Exit Sub
    DoEvents
    Application.StatusBar = "------heure d'ouverture fichier : " & timerstart & "    temps passé:  " & x & mess & y
    Application.OnTime Now + 0.00005, "ThisWorkbook.lookinstatusbar"
End Sub

Sub fermeture()
    MsgBox "c'est ici que tu met ton code de fermeture"
End Sub

 

[job75]

Re, salut patricktoulon,

peut on afficher le décompte dans le status bar?

Toujours dans Thisworkbook :

Dim t 'mémorise la variable

Private Sub Workbook_Open()
t = Now + TimeValue("00:05:00")
Fermer
End Sub

Private Sub Fermer()
Application.StatusBar = "Temps restant " & Format(t - Now, "hh:mm:ss")
If t > Now Then Application.OnTime Now + 1 / 86400, Me.CodeName & ".Fermer": Exit Sub 'relance chaque secondee
Application.StatusBar = ""
If Me.ReadOnly Then Me.Saved = True Else Me.Save 'en lecture seule pas d'enregistrement
If Workbooks.Count = 1 Then Application.Quit Else Me.Close
End Sub

Ne pas oublier la ligne Dim t (à placer en haut de la page de code).

A+