Stopper une macro (timer) à la fermeture du fichier

Bonjour au forum,

Sauriez-vous comment fermer une macro à la fermeture du fichier qui la contient, pour éviter qu'elle fonctionne encore si un autre fichier Excel est ouvert ?

En effet, j'ai mis en place un timer sur un fichier très régulièrement ouvert par les utilisateurs qui oublient systématiquement de le fermer... Mais je me suis rendu compte que si un autre fichier Excel est ouvert en même temps, la macro "Timer" est encore active et me ré-ouvre automatiquement le fichier qui la contient....

Le fichier concerné étant extrêmement lourd et contenant des données sensibles, il me sera difficile d'en mettre une version allégée sur le forum, donc je tente déjà ma chance sans... Si cela s'avérait être nécessaire malgré tout, j'essayerai d'en faire une version partageable

Merci d'avance à vous !

Bonjour,

Tu as bien un dispositif d'arrêt ?

(Si ce n'est pas le cas, cela relève d'une mauvaise conception du programme.)

Il te suffit de l'actionner systématiquement à la fermeture !

(Et pareil, cela se prévoit dès la conception !)

Cordialement.

Bonjour,

[EDIT] Ferrand :

Une solution : En supposant que ton timer fonctionne sur la base de OnTime sinon c'est une autre histoire...

'Dans Module 1
Public temps
Sub majHeure()
ThisWorkbook.Sheets("feuil1").[A1] = Now
temps = Now + TimeValue("00:00:10")
Application.OnTime temps, "majHeure"
End Sub

'Dans ThisWorkbook
Private Sub Workbook_Open()
majHeure
End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)
On Error Resume Next
Application.OnTime temps, Procedure:="majHeure", Schedule:=False
End Sub

A+

Bonjour MFerrand, Galopin01,

Merci pour vos réponses !

Voici mon code pour le Timer :

Option Explicit

Public Ws As Worksheet
Public Attente As Variant
Public StopDecompte As Byte

Const Veille As Variant = "03:00:00" '-------------- délai d'attente avant apparition du décompte normal
Const StopLong As Variant = "01:00:00" '-------------- délai d'attente avant apparition du décompte long
Const Rebours As Variant = "10" '------------------- durée du décompte exprimé en secondes
Const Alert As Variant = "5" '--------------------- durée de l'alerte sonnore exprimée en secondes

'****************************** Gére la fermeture du fichier si inactivité ******************************
Private Sub StartTimer()
' -------------------------- Lance le timer d'attente
    Attente = Now + TimeValue(Veille) ' ------------- utiliser la constante Veille
    'Attente = Now + TimeValue("00:01:00") ' -------- ou saisir la durée de la veille
    Application.OnTime Attente, "Avertissement" '------ lance la procédure "Avertissement" au moment définit par "Attente"
End Sub

Private Sub StartLongTimer()
' -------------------------- Lance le timer d'attente
    Attente = Now + TimeValue(StopLong) ' ------------- utiliser la constante StopLong
    'Attente = Now + TimeValue("00:01:00") ' -------- ou saisir la durée de la veille
    Application.OnTime Attente, "Avertissement" '------ lance la procédure "Avertissement" au moment définit par "Attente"
End Sub

Private Sub StopTimer()
    On Error Resume Next
' ---------------- Stoppe la procédure d'attente
    CRebours.Hide ' ------------------ ferme l'userform
    Application.OnTime EarliestTime:=Attente, Procedure:="Avertissement", Schedule:=False
    Application.OnTime EarliestTime:=Attente, Procedure:="FermerWbk", Schedule:=False
    On Error GoTo 0
End Sub

Private Sub Avertissement()
  ' ----------------------- Suspend la procédure d'attente
  On Error Resume Next
  Call StopTimer
  CRebours.Label1.Caption = vbCrLf & " Attention !" & vbCrLf & "Sans activité, le fichier se fermera " & vbCrLf & "automatiquement dans :"
  Test
'  Attente = Now + TimeValue("00:00:30")
'  If CRebours.Label2.Caption = 0 Then FermerWbk
    On Error GoTo 0
End Sub

'****************************** Gére le compte à rebours ********************************************

Private Sub Minuterie(Sec As Single)
' ------------------- Lance le timer du compte à rebours
    Dim Arret As Single
    On Error Resume Next
    Arret = Timer + Sec
    Do While Timer < Arret
    DoEvents
    Loop
    On Error GoTo 0
End Sub

Private Sub Decompte(Optional I As Integer = 15)
    On Error Resume Next
    Do While I >= 0
    If StopDecompte > 0 Then Exit Do
    CRebours.Label2.Caption = I
    CRebours.Label2 = Format((I / 24 / 60 / 60), "hh:mm:ss")
    Minuterie 1   '1 = 1 seconde, 0.5 = une 1/2 seconde, etc... et 0.1 = 1 dixième de seconde
    I = I - 1
    If CRebours.Visible = True And I <= Alert Then Beep ' ----------- ajoute un Beep pendand le décompte final en utilisant la constante Alert
   ' If CRebours.Visible = True And i <= 10 Then Beep ' ----------- ajoute un Beep pendand le décompte final avec saisi de la durée
    If CRebours.Visible = True And I = 0 Then Fermeture
    Loop
    On Error GoTo 0
End Sub

Private Sub Test()
    On Error Resume Next
    CRebours.Show False ' ------------ appelle l'Userform et False libère le code permettant de travailler sur la feuille
     Decompte Rebours ' --------------- durée du décompte en utilisant la constante Rebours
    'Decompte 0.5 * 60 ' -------------- durée du décompte saisie de la durée ici 05*60 soit 30 sencondes
    Unload CRebours ' ---------------- ferme et désactive l'userform
    On Error GoTo 0
End Sub

Private Sub Fermeture()

StopTimer

Application.Run ("coller_on")
Application.Run ("RéactiverCtrlCV")

Application.ScreenUpdating = False

Sheets("Accueil").Visible = xlSheetVisible

For Each Ws In ThisWorkbook.Worksheets
    If Ws.Name <> "Accueil" Then Ws.Visible = xlSheetVeryHidden
Next Ws

Application.ScreenUpdating = True

'backup iphone

ThisWorkbook.Save

Application.Quit
End Sub

J'appelle la procédure "Fermeture" dans ThisWorkbook_BeforeClose, qui contient StopTimer et qui devrait donc m'arrêter le Timer... Non ?

Pas d’idées mes amis ?

Le code est peut-être un peu trop long... ?

Merci d'avance

Pourquoi faire simple quand on peut faire compliqué hein !

galopin01 a écrit :

Pourquoi faire simple quand on peut faire compliqué hein !

C'est une bonne remarque...

Mais n'étant pas très connaisseur de VBA, j'essaie de faire au mieux.

Le Timer mis en place permet de fermer le fichier après un certain d'inactivité tout en ayant la possibilité de l'utiliser sans contrainte.

Pour cela, une réinitialisation du compte à rebours est initiée à chaque clique de souris quelque soit la feuille et à chaque changement de feuille.

Au bout du décompte définit par la constante "Veille", un UserForm (CRebours) s'affiche avec le décompte de la constante "Rebours" dans un Label.

A ce stade, soit le décompte "Rebours" arrive à 0 et la procédure "Fermeture" est appelée, soit on clique sur un bouton "Fermer le fichier", et là aussi la procédure "Fermeture" est appelée, soit on clique sur un bouton "Revenir sur le fichier", qui relance le Timer (constante "Veille").

Je pensais que cette ligne de code suffisait à annuler le Timer :

Private Sub StopTimer()
    On Error Resume Next
' ---------------- Stoppe la procédure d'attente
    CRebours.Hide ' ------------------ ferme l'userform
    Application.OnTime EarliestTime:=Attente, Procedure:="Avertissement", Schedule:=False
    On Error GoTo 0
End Sub

mais ce n'est visiblement pas le cas...

Sauriez-vous pourquoi ?

Petit up...