Désactiver macro en cours

[Neofalken]

Bonjour à tous

J'ai eu beau chercher je ne trouve pas d'antécédents à mon problème...

J'ai un timer pour la fermeture d'un fichier partagé (si qq'un oublie de le fermer et qui tte son poste il se ferme automatiquement et le rend à nouveau disponible)
J'aimerais pouvoir désactiver ce timer avec un bouton : Une macro qui désactive la macro timer
J'espère avoir été assez clair .

QQ'un peut-il m'aider ? Merci d'avance

Voici mon code :

Dans "this workbook"

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
On Error Resume Next
Application.OnTime HeureArrêt, Procedure:="Fin", Schedule:=False
ProchainArret
End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)
'ThisWorkbook.Save
On Error Resume Next
Application.OnTime HeureArrêt, Procedure:="Fin", Schedule:=False ' annule événnement
Application.OnTime temps, Procedure:="majHeure", Schedule:=False
End Sub

Dans un module

Public HeureArrêt
Public Délai
Public Reste
Public temps

Dim Cell_Row As Long
Dim Cell_Col As Long
Dim Cell_Test As String
Dim Pos_Char As Integer
Dim Pos_Char_Tot As Integer
Dim Cell_Test_Temp As String
Dim Nbre_Chiffre As Integer
Dim Val_Chiffre As String
Dim Test_Sep As Integer
Dim Nickname As String
Dim Type_LH As String
Dim Increment As Integer
Dim Col_Date As Integer

Sub ProchainArret()
HeureArrêt = Now + Délai
Application.OnTime HeureArrêt, "Fin"
Reste = Délai
End Sub

Sub Fin()
On Error Resume Next
Application.OnTime temps, Procedure:="majHeure", Schedule:=False
Application.OnTime HeureArrêtt, Procedure:="Fin", Schedule:=False 'annule événnemennt
Application.WindowState = xlNormal

ThisWorbook.Save = True

If Not Intersect(Target, Range("C2")) Is Nothing Then

Dim OutApp As Object, OutMail As Object 'envoyer le mail
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
On Error Resume Next
With OutMail
.To = Environ("username") 'adresse du destinataire
.Subject = "nom du fichier"


.Display

.Send 'envoyer directement le mail
End With
On Error GoTo 0
Set OutMail = Nothing
Set OutApp = Nothing

End If

ThisWorkbook.Close True
End Sub

Sub majHeure()
On Error Resume Next
ActiveSheet.[A1] = Reste
Reste = Reste - TimeValue("00:00:05")
temps = Now + TimeValue("00:00:05")
Application.OnTime temps, "majHeure"
End Sub

 

[Softmama]

Re : Désactiver macro en cours

Bonjour,

dans la feuille où se trouve ton bouton d'annulation :

Private Sub CommandButton1_Click()
  Call Annulation
End Sub

Dans un module :

Sub Annulation()
  Application.OnTime temps, Procedure:="majHeure", Schedule:=False
  Application.OnTime HeureArrêtt, Procedure:="Fin", Schedule:=False 
End Sub

à tester.

 

[Neofalken]

Re: Re : Désactiver macro en cours

Bonjour Softmama

Merci bcp pour ton aide. c'est exactement ce qu'il me fallait !!!