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

Michest94

Michest94

XLDnaute Occasionnel
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 à l'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,
 
Solution
Michest94
patricktoulon à dit:
re
bon allez tiens
et la prochaine fois ne mélange pas des sujets ,même si c'est pour le même classeur
ta question intéresse d'autres personnes plus ca reste clair mieux c'est
donc pour ta totale
VB: 
Dim timerstart
Dim rupturcycle As Boolean
Const durée_max As String = "00:05:00"    'Adapter la durée souhaitée

Private Sub Workbook_BeforeClose(Cancel As Boolean)
    rupturcycle = True
    ThisWorkbook.Save
End Sub

Private Sub Workbook_Open()
    timerstart = TimeValue(Now)
    lookinstatusbar
End Sub

Sub lookinstatusbar()
    Dim heure1, x, y
    If Not rupturcycle Then
        heure1 = TimeValue(Now)
        x = Application.Text(heure1 - timerstart, "[hh]:mm:ss")
        minute_max = TimeValue(durée_max)
        y =...
Cliquez pour agrandir...
Trier par date Trier par votes
sylvanu

sylvanu

XLDnaute Barbatruc
Supporter XLD
Dans le code que vous avez donné, nulle part je ne vois Sub Compteur() . Où avez vous implémenté cette macro ?

Ensuite le problème vient peut être du fait que vous avez un tableau structuré nommé Compteur, il se mélange peut être un peu les pinceaux.

C'est pour cela qu'un PJ est toujours la bienvenue, le contexte est aussi important que le code.
 
Vote positif 0 Vote négatif
sylvanu

sylvanu

XLDnaute Barbatruc
Supporter XLD
Comme dit au post #16 c'est le nom Compteur qui lui plait pas, en changeant par CompteurTemps ça marche.
Il se mélange les pinceaux entre le nom de la sub et le nom du tableau structuré.
NB : Dans la PJ j'ai supprimé une grosse partie de Workbook_Open car cela générait plein d'erreur due aux protections, mais rien à voir avec notre pb.
vérifiez la PJ telle qu'elle, j'ai remis le temps à 15s pour le test.
Si ça marche, dans votre fichier rebaptisez simplement tous les Compteur par CompteurTemps , il doit y en avoir 4 en tout, un dans Thisworkbook et 3 dans module2 que j'ai rebaptisé CLK dans ma PJ.
 

Pièces jointes

  • FichierTEST.xlsm
    132.1 KB · Affichages: 8
Vote positif 0 Vote négatif
Michest94

Michest94

XLDnaute Occasionnel
sylvanu à dit:
Comme dit au post #16 c'est le nom Compteur qui lui plait pas, en changeant par CompteurTemps ça marche.
Il se mélange les pinceaux entre le nom de la sub et le nom du tableau structuré.
NB : Dans la PJ j'ai supprimé une grosse partie de Workbook_Open car cela générait plein d'erreur due aux protections, mais rien à voir avec notre pb.
vérifiez la PJ telle qu'elle, j'ai remis le temps à 15s pour le test.
Si ça marche, dans votre fichier rebaptisez simplement tous les Compteur par CompteurTemps , il doit y en avoir 4 en tout, un dans Thisworkbook et 3 dans module2 que j'ai rebaptisé CLK dans ma PJ.
Cliquez pour agrandir...
Ok merci je vérifie tout ça.
 
Vote positif 0 Vote négatif
Michest94

Michest94

XLDnaute Occasionnel
Re,

Le compteur (timer) fonctionne nickel par contre dans la partie Workbook_Open que tu as épuré ceci me cause le problème suivant
1615823057822.png


En mode Admin je n'ai plus aucun de mes onglets de gestion du classeur.
 
Vote positif 0 Vote négatif
patricktoulon

patricktoulon

XLDnaute Barbatruc
bonjour
un exemple pour le fun
mise a jour de la statusbar tout les 5 secondes départ durée écoulée et temps restant sub de fermeture déclenchée a la fin
VB: 
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
 
Vote positif 0 Vote négatif
Michest94

Michest94

XLDnaute Occasionnel
patricktoulon à dit:
bonjour
un exemple pour le fun
mise a jour de la statusbar tout les 5 secondes départ durée écoulée et temps restant sub de fermeture déclenchée a la fin
VB: 
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
Cliquez pour agrandir...

patricktoulon à dit:
bonjour
un exemple pour le fun
mise a jour de la statusbar tout les 5 secondes départ durée écoulée et temps restant sub de fermeture déclenchée a la fin
VB: 
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
Cliquez pour agrandir...
Bonjour
J'ai appliqué le code dans mon projet nickel et sympa.
Par contre si je veux quitter le classeur avant la fin du timer en passant par la croix en haut à droite avec sauvegarde j'ai appliqué

ActiveWorkbook.Close True 'Enregistrement par défaut
dans
Private Sub Workbook_BeforeClose(Cancel As Boolean)

et il ferme le classeur mais j'ai ce message
1615829538759.png


puis
1615829590658.png

Je n'arrive pas à sortir
 
Vote positif 0 Vote négatif
patricktoulon

patricktoulon

XLDnaute Barbatruc
ben tu n'a qua prevoir de rmpre le cycle tout simplement
avec (par exemple )une variable globale boolean comme condition
VB: 
Dim timerstart
Dim rupturcycle As Boolean
Const durée_max As String = "00:05:00" 'Adapter la durée souhaitée

Private Sub Workbook_BeforeClose(Cancel As Boolean)
rupturcycle = True

End Sub

Private Sub Workbook_Open()
    timerstart = TimeValue(Now)
    lookinstatusbar
End Sub

Sub lookinstatusbar()
    Dim heure1, x, y
If Not rupturcycle Then
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 If
End Sub

Sub fermeture()
    MsgBox "c'est ici que tu met ton code de fermeture"
End Sub
et voila ;)
par contre je ne sais pas ce que ce c'est ce fichier install je sais pas quoi
tu a du installer une cochonnerie
 
Vote positif 0 Vote négatif
Michest94

Michest94

XLDnaute Occasionnel
Re,

Très bien sauf qu'une sauvegarde par défaut juste avant de quitter soit par le timer soit par la croix en haut à droite aurait été parfait car dans mon fichier les cellules sont protégées en écriture donc protégées sauf 2 formulaires 1 pour d'éventuels avis et 1 autre pour demande de mise à jour.
Merci à toi
 
Vote positif 0 Vote négatif
patricktoulon

patricktoulon

XLDnaute Barbatruc
re
bon allez tiens
et la prochaine fois ne mélange pas des sujets ,même si c'est pour le même classeur
ta question intéresse d'autres personnes plus ca reste clair mieux c'est
donc pour ta totale
VB: 
Dim timerstart
Dim rupturcycle As Boolean
Const durée_max As String = "00:05:00"    'Adapter la durée souhaitée

Private Sub Workbook_BeforeClose(Cancel As Boolean)
    rupturcycle = True
    ThisWorkbook.Save
End Sub

Private Sub Workbook_Open()
    timerstart = TimeValue(Now)
    lookinstatusbar
End Sub

Sub lookinstatusbar()
    Dim heure1, x, y
    If Not rupturcycle Then
        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 If
End Sub

Sub fermeture()
    rupturcycle = True
    ThisWorkbook.Save
    If Workbooks.Count = 1 Then Application.Quit Else ThisWorkbook.Close
End Sub
et tu n'aura pas de soucis ;)
 
Vote positif 0 Vote négatif
patricktoulon

patricktoulon

XLDnaute Barbatruc
bizarrement je vois pas le rapport mais si il y a plusieurs classeurs d'ouverts il y a une erreur encore
du coup on shunte l'erreur qui peut eventuellement se produire à la fin
VB: 
Dim timerstart
Dim rupturcycle As Boolean
Const durée_max As String = "00:05:00"    'Adapter la durée souhaitée

Private Sub Workbook_BeforeClose(Cancel As Boolean)
    rupturcycle = True
    ThisWorkbook.Save
End Sub

Private Sub Workbook_Open()
    timerstart = TimeValue(Now)
    lookinstatusbar
End Sub

Sub lookinstatusbar()
    Dim heure1, x, y
   On Error Resume Next
   If Not rupturcycle Then
        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 If
End Sub

Sub fermeture()
    rupturcycle = True
    ThisWorkbook.Save
    If Workbooks.Count = 1 Then Application.Quit Else ThisWorkbook.Close
End Sub
j'ai testé ca match ;)
 
Vote positif 0 Vote négatif
Michest94

Michest94

XLDnaute Occasionnel
patricktoulon à dit:
re
bon allez tiens
et la prochaine fois ne mélange pas des sujets ,même si c'est pour le même classeur
ta question intéresse d'autres personnes plus ca reste clair mieux c'est
donc pour ta totale
VB: 
Dim timerstart
Dim rupturcycle As Boolean
Const durée_max As String = "00:05:00"    'Adapter la durée souhaitée

Private Sub Workbook_BeforeClose(Cancel As Boolean)
    rupturcycle = True
    ThisWorkbook.Save
End Sub

Private Sub Workbook_Open()
    timerstart = TimeValue(Now)
    lookinstatusbar
End Sub

Sub lookinstatusbar()
    Dim heure1, x, y
    If Not rupturcycle Then
        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 If
End Sub

Sub fermeture()
    rupturcycle = True
    ThisWorkbook.Save
    If Workbooks.Count = 1 Then Application.Quit Else ThisWorkbook.Close
End Sub
et tu n'aura pas de soucis ;)
Cliquez pour agrandir...
MERCI
 
Vote positif 0 Vote négatif
Solution

Discussions similaires

Michest94
  • Résolu(e)
Microsoft 365 TIMER (comptage ou décomptage) à l'ouverture du classeur
Réponses
9
Affichages
1 K
job75
job75
L
  • Question
XL 2016 Forcer l'arrêt d'un Timer dès la sortie d'un Formulaire
Réponses
6
Affichages
605
Lorenzini
L
Y
  • Résolu(e)
XL 2019 Après un "No_Splash Screen" la désactivation des macros ne réponds plus pour empêcher l'ouverture du classeur.
Réponses
8
Affichages
673
Cousinhub
Cousinhub
D
  • Question
XL 2016 VBA 6 Erreur à l'ouverture du classeur
Réponses
0
Affichages
671
danielco
D
F
  • Question
XL 2019 Avis macro sur classeur maître
Réponses
0
Affichages
688
Fanrs
F
Michest94
  • Résolu(e)
XL 2016 Appliquer une MFC par rapport à un compteur qui décompte
Réponses
2
Affichages
809
Michest94
Michest94
K
  • Question
Fichier Excel en lecture seule à l'ouverture avec message Modifier le classeur?
Réponses
1
Affichages
4 K
ligory
L
M
  • Question
Obtenir l'information de mise à jour du classeur
Réponses
3
Affichages
1 K
herve62
herve62
L
  • Question
filtre auomatique avec selection combobox à l'ouverture du classeur
2 3
Réponses
37
Affichages
3 K
Paritec
Paritec
A
  • Question
Grouper des plans d'une feuille protégée à la fermeture (ou l'ouverture) du classeur
Réponses
1
Affichages
609
JCGL
JCGL

Membres actuellement en ligne

17 membres et 134 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
315 093
Messages
2 116 140
Membres
112 669
dernier inscrit
Guigui2502