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
