XL 2016 Procédure de fermeture automatique de fichier

JPrev

XLDnaute Junior
Bonjour à tous les forumers,

J'ai dans un fichier un code me permettant d'enregistrer et fermer un fichier inactif pendant un temps donné (ici 15minutes) :

MODULE

Option Explicit
Dim DownTime As Date
Sub SetTimer()
DownTime = Now + TimeValue("00:15:00")
Application.OnTime EarliestTime:=DownTime, _
Procedure:="ShutDown", Schedule:=True
End Sub
Sub StopTimer()
On Error Resume Next
Application.OnTime EarliestTime:=DownTime, _
Procedure:="ShutDown", Schedule:=False
On Error GoTo 0
End Sub
Sub ShutDown()
Application.DisplayAlerts = False
Workbooks("1.Suivi Sécurité Béthune F22.xlsm").Save
With ThisWorkbook
.Saved = True
.Close
End With
End Sub

THIS WORKBOOK

Option Explicit
Private Sub Workbook_Open()
Call SetTimer
End Sub
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Call StopTimer
End Sub
Private Sub Workbook_SheetCalculate(ByVal Sh As Object)
Call StopTimer
Call SetTimer
End Sub
Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, _
ByVal Target As Excel.Range)
Call StopTimer
Call SetTimer
End Sub


Lorsque ce fichier est ouvert, les fichiers excel que j'ouvre me donnent le message d'erreur en pièce jointe. Est-ce que je dois préciser dans les procédures qu'elles ne concernent que mon fichier concerné?

J'espère avoir été clair, sinon laissez-moi vos questions pour que je puisse y répondre.

Merci d'avance pour votre aide,

JPrev
 

Pièces jointes

  • Capture.JPG
    Capture.JPG
    14.6 KB · Affichages: 15

riton00

XLDnaute Impliqué
Bonjour,
Chez moi cela ne génère pas d'erreur voir si ton fichier s'appelle bien 1.Suivi Sécurité Béthune F22.xlsm comme indiqué sur ta macro

MODULE
Option Explicit
Dim DownTime As Date
Sub SetTimer()
DownTime = Now + TimeValue("00:15:00")
Application.OnTime EarliestTime:=DownTime, _
Procedure:="ShutDown", Schedule:=True
End Sub
Sub StopTimer()
On Error Resume Next
Application.OnTime EarliestTime:=DownTime, _
Procedure:="ShutDown", Schedule:=False
On Error GoTo 0
End Sub
Sub ShutDown()
Application.DisplayAlerts = False
Workbooks("1.Suivi Sécurité Béthune F22.xlsm").Save
With ThisWorkbook
.Saved = True
.Close
End With
End Sub

Slts
 

BrunoM45

XLDnaute Barbatruc
Bonjour messieurs,

Savez-vous qu'il existe depuis longtemps un bouton pour y mettre votre code 🤔
1631323699056.png


Il serait bien d'y prêter attention 😜
 

krimoines

XLDnaute Nouveau
Bonjour,
Chez moi cela ne génère pas d'erreur voir si ton fichier s'appelle bien 1.Suivi Sécurité Béthune F22.xlsm comme indiqué sur ta macro

MODULE
Option Explicit
Dim DownTime As Date
Sub SetTimer()
DownTime = Now + TimeValue("00:15:00")
Application.OnTime EarliestTime:=DownTime, _
Procedure:="ShutDown", Schedule:=True
End Sub
Sub StopTimer()
On Error Resume Next
Application.OnTime EarliestTime:=DownTime, _
Procedure:="ShutDown", Schedule:=False
On Error GoTo 0
End Sub
Sub ShutDown()
Application.DisplayAlerts = False
Workbooks("1.Suivi Sécurité Béthune F22.xlsm").Save
With ThisWorkbook
.Saved = True
.Close
End With
End Sub

Slts
bonsoir riton00 je voudrais faire la même chose avec mon fichier.
 

Pièces jointes

  • SUIVI DES VACCINS.xlsx
    74.7 KB · Affichages: 2

riton00

XLDnaute Impliqué
Bonsoir,

Voir en Pj..... si cela te convient,
Ps: pour bon fonctionnement activer les macros à l'ouverture du fichier

Actuellement le fichier est programmé pour être fermé à environ 1 minute si pas d'activité, cette valeur peu être modifier dans le module par le raccourci clavier ALT+F11

Slts
 

Pièces jointes

  • SUIVI DES VACCINS.xlsm
    97.9 KB · Affichages: 2

Discussions similaires