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

Michest

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
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")...

sousou

XLDnaute Barbatruc
Ici un code qui affiche dans la barre d'état l'heure et le nombre de secondes restantes, à adapter pour tes besoins
Public intervalle, durée, t, compte
Sub t1()
durée = TimeValue("00:00:10")
compte = Hour(durée) * 3600 + Minute(durée) * 60 + Second(durée) + 1
t = Now + durée
temps
End Sub
Sub temps()
intervalle = TimeValue("00:00:01")
t2
End Sub

Sub t2()

Application.StatusBar = Time & " Nb de secondes restantes : " & compte
compte = compte - 1
If Date + Time > t Then End

Application.OnTime Now + intervalle, "temps"
End Sub
 

Michest

XLDnaute Occasionnel
Bonjour Michest, Sousou,
Pourquoi un doublon : https://www.excel-downloads.com/thr...ouverture-du-classeur.20055020/#post-20413019
Vous devriez plutôt répondre aux propositions qui vous ont été faites.
Bj Sylvanu,Sousou

Désolé pour la réponse tardive. Le doublon de post est une erreur.
J'essaie d'adapter à mon fichier réel et les différentes propositions pas simple quand on domine pas le vba.
Cela me parait très bien dès que je réussit à l'adapter je reviens poster.
En tout les cas merci.
 

Michest

XLDnaute Occasionnel
Bj Sylvanu,Sousou

Désolé pour la réponse tardive. Le doublon de post est une erreur.
J'essaie d'adapter à mon fichier réel et les différentes propositions pas simple quand on domine pas le vba.
Cela me parait très bien dès que je réussit à l'adapter je reviens poster.
En tout les cas merci.
Pour le test de Sylvanu
j'ai la pop up suivante alors que j'ai adapté le code dans mon fichier
1615804305128.png
 

Michest

XLDnaute Occasionnel
Ici un code qui affiche dans la barre d'état l'heure et le nombre de secondes restantes, à adapter pour tes besoins
Public intervalle, durée, t, compte
Sub t1()
durée = TimeValue("00:00:10")
compte = Hour(durée) * 3600 + Minute(durée) * 60 + Second(durée) + 1
t = Now + durée
temps
End Sub
Sub temps()
intervalle = TimeValue("00:00:01")
t2
End Sub

Sub t2()

Application.StatusBar = Time & " Nb de secondes restantes : " & compte
compte = compte - 1
If Date + Time > t Then End

Application.OnTime Now + intervalle, "temps"
End Sub
Merci sousou pour le retour,

le code je dois le placer dans un nouveau module? ou dans le thisworkbook
 

Michest

XLDnaute Occasionnel
Re,
La pj fonctionne très bien
Sauf quand je ferme (croix en haut à droite )avant la fin du timer j'ai le msg Regarde la pièce jointe 1098694
Re Sylvanu,

A tout hazard si tu veux bien m'aidé en jaune le code que tu m'as mis à dispo

Private Sub Workbook_Open()
nocompt = True
TempsRestant = 300 ' Init du temps en secondes. Ici 30s pour test. Mettre 300 pour 5min.
Compteur

Application.ScreenUpdating = False
ActiveWindow.ScrollColumn = 1
ActiveWindow.ScrollRow = 1

Feuil1.ComboBox1.Text = "Sélectionner site >>"
Feuil1.ComboBox2.Text = "Sélectionner site >>"

' Masquage lignes/colonnes et barre formule
ActiveWindow.DisplayHeadings = False
Application.DisplayFormulaBar = False

' DeMasquage des onglets
ActiveWindow.DisplayWorkbookTabs = True

Sheets("Login").Protect "ADMIN1967"
Sheets("Login").Visible = True ' seul Login sera visible

'On Error Resume Next
'Masquage des feuilles sauf Login qui est la 1ere feuille et protection des feuilles 2 à 7 uniquement
For N = 2 To Sheets.Count
Sheets(N).Visible = False
'If n < 8 Then Sheets(n).Protect "ADMIN1967"
If N < 9 Then Sheets(N).Protect "ADMIN1967"
Next

' on vide la cellule nom
Worksheets("Login").Range("D35") = ""
' on vide le textbox et on remet les ***
Worksheets("Login").TextBox_mdp = ""
Worksheets("Login").TextBox_mdp.PasswordChar = "*"

If Sheets("ACCUEIL").ProtectContents = False Then Sheets("ACCUEIL").Protect "ADMIN1967"
Sheets("ACCUEIL").EnableSelection = xlUnlockedCells

'Gestion compteur pour date et Login
Dim Auj&, ligne%
Auj = Date 'Auj = date du jour
If Application.CountIf(Range("Compteur[Dates]"), Auj) = 0 Then 'si date du jour n'existe pas dans colonne dates
Sheets("Cpt").ListObjects("Compteur").ListRows.Add 'ajouter une ligne
ligne = Sheets("Cpt").Range("Compteur").Rows.Count 'ligne = nombre de lignes du tableau (après l'ajout)
Sheets("Cpt").Range("Compteur[Dates]")(ligne) = Date 'dernière cellule de Dates = date du jour
Else
ligne = Application.Match(Auj, Sheets("Cpt").Range("Compteur[Dates]"), 0) 'sinon, ligne = position de correspondance dans Dates
End If
Sheets("Cpt").Range("Compteur[Login]")(ligne) = Sheets("Cpt").Range("Compteur[Login]")(ligne) + 1
Sheets("Cpt").Range("K1") = ligne 'place le n° ligne de la date en J1
End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)
nocompt = True

Sheets("Login").Visible = True ' car il doit y avoir au moins une feuille visible quand on aura fermé toutes les autres
'Masquage des feuilles sauf Login qui est la 1ere feuille et protection des feuilles 2 à 7 uniquement
For N = 2 To Sheets.Count
Sheets(N).Visible = False
'If n < 8 Then Sheets(n).Protect "ADMIN1967"
If N < 9 Then Sheets(N).Protect "ADMIN1967"
Next

' on vide la cellule nom
Worksheets("Login").Range("D35") = ""

' on vide le textbox et on remet les ***
Worksheets("Login").TextBox_mdp = ""
Worksheets("Login").TextBox_mdp.PasswordChar = "*"

'reprotection
Sheets("Login").Protect "ADMIN1967"

' Masquage des onglets
ActiveWindow.DisplayWorkbookTabs = False

'ActiveWorkbook.Close True 'Enregistrement par défaut
Sheets("Login").Activate 'Chargement du fichier sur la page Login

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

Private Sub Workbook_SheetActivate(ByVal Sh As Object)
Me.BuiltinDocumentProperties("subject") = Sh.Name

'GESTION FLAG
If Sh.Name = "Intervenant" Then
ActiveSheet.Unprotect "ADMIN1967"
Range("i2") = ""
With Sheets("MAJ")
v = 0
On Error GoTo suite
ligne = .Columns(2).Find(Range("C3"), , , , xlByColumns, xlPrevious).Row
avant = WorksheetFunction.EDate(Date, -6)
If CDate(.Range("A" & ligne)) >= avant Then v = CDate(.Range("A" & ligne))
suite:
End With
If v > 0 Then
aff = "MAJ " & Format(v, "dd/mm/yy")
Range("I2").Select
ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:="", SubAddress:= _
"MAJ!A1", TextToDisplay:=aff
End If

'ActiveSheet.Protect "ADMIN1967"
If VarLogin <> "ADMIN" Then ActiveSheet.Protect "ADMIN1967"
End If

If nocompt = True Or VarLogin = "ADMIN" Then Exit Sub ' pour éviter de compter à ouverture classeur ou si admin

'récupération de la ligne du jour dans cpt (détérminée à fin de Workbook Open)
ligne = Sheets("Cpt").Range("K1")

' GESTION DES COMPTEURS feuilles
'If (Sh.Name = "Intervenant" And noInt = False) Or (Sh.Name = "Prestataire" And noPre = False) Or (Sh.Name = "Documentations" And noDoc = False) Or (Sh.Name = "Bilans" And noBil = False) Or (Sh.Name = "Instrumentations" And noIns = False) Then
If (Sh.Name = "Intervenant" And noInt = False) Or (Sh.Name = "Prestataire" And noPre = False) Or (Sh.Name = "Documentations" And noDoc = False) Or (Sh.Name = "Bilans" And noBil = False) Or (Sh.Name = "Instrumentations" And noIns = False) Or (Sh.Name = "MAJ" And noMaj = False) Then
Sheets("Cpt").Range("Compteur[" & Sh.Name & "]")(ligne).Value = Sheets("Cpt").Range("Compteur[" & Sh.Name & "]")(ligne).Value + 1 'dans tous les cas, la colonne correspondant à la feuille activée est incrémentée
End If

End Sub
'-------REMARQUES------
'Si feuilles 1 et 2 renommées, adapter le code
'>>> éventuellement modifier le if ainsi : if sh.name = "nom1" or sh.name = "nom2" then
'si feuille Cpt renommée, adapter le code
'Si tableau ou colonnes renommées, adapter le code


'Protection ENREGISTRER SOUS
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
If SaveAsUI Then MsgBox ("Commande INTERDITE!... ")
Cancel = SaveAsUI
End Sub

et pour le module
Merci à toi si tu peut m'aider tu m'avait bien aidé sur un projet perso de gestion compte multi compte
1615813969370.png
 

Michest

XLDnaute Occasionnel
J'ai mis sur le post #9 le code de mes macros thisworkbook et le module 2 ( image de la liste des macros ) avant adaptation en V2.
Je vais essayé de faire un fichier simplifié de mon fichier réel.
Sinon le code à dispo fonctionne très bien et le résultat est parfait .
 
Haut Bas