XL 2016 Procédure de fermeture automatique de fichier

[JPrev]

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

 

[riton00]

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

 

[Compte Supprimé 979]

Bonjour messieurs,

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

Il serait bien d'y prêter attention

 

[riton00]

Bonjour, BrunoM45

Merci de le rappeler, il est vrai..... j'étais dans le feu de l'action, et du coup, cela m'est sortie de la tête

 

[krimoines]

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.

 

[riton00]

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

 

[krimoines]

bonjour riton00 merci pour ce travail c'est ce que je cherche le fichier se ferme automatiquement, pour la durée je vais revoir la programmation.
je vous souhaite une bonne et belle journée si j'ai un blem je retour vers vous.