XL 2013 Arrêt macro ne fonctionne pas

[Nico77]

Bonjour

Quand je clic pour un arrêt de la macro il me surligne la ligne, pourquoi, quel est l'erreur?

Sub Arret()
Application.OnTime Intervalle, "Clign1", , False
End Sub

Merci a vous.

bonne journée

 

[Dranreb]

Si, c'est classique: si un classeur est fermé avant qu'une planification par Application.OnTime n'ait été exécutée, le classeur est réouvert pour assumer son exécution. Pour éviter cela, avant fermeture, refaire Application.OnTime avec Shedule:=False en spécifiant la même heure que celle qui avait été spécifiée. Cela implique de la conserver dans une variable globale. Mon objet Planification a des méthode simples:

Rem. Cette classe permet d'exploiter un Application.Ontime dans des objets, via un évènement Échoit.
Option Explicit
Event Échoit() ' Évènement. Se produit à l'échéance du délai.
Private HOT As Date, Idt As Long
Public Sub PlanifierDans(ByVal Délai)
Rem. Méthode. Planifie l'évènement Échoit dans un délai indiquée.
'     Délai: Expression String de la forme "hh:mm:ss" ou bien un nombre de secondes.
'     Remarque: Une éventuelle planification préalable est annulée.
   If Engagé Then XPlanificateur.AnnulerPlanification Idt
   If VarType(Délai) = vbString Then HOT = Now + TimeValue(Délai) Else HOT = Now + TimeSerial(0, 0, Délai)
   Idt = XPlanificateur.IdtPlanificationLancée(Me)
   End Sub
Public Sub Annuler()
Rem. Méthode. Annule la dernière planification s'il en existe une.
   If Idt > 0 Then XPlanificateur.AnnulerPlanification Idt: Idt = 0
   End Sub
Public Function HeureOT() As Date
Rem. Propriété en lecture seule. Dernière heure de planification.
   HeureOT = HOT
   End Function
Public Function Engagé() As Boolean
Rem. Propriété en lecture seule. Condition planification lancée.
   Engagé = Idt > 0
   End Function
Public Sub Actionner()
Rem. Méthode. Déclenche l'évènement Échoit.
'     Son invocation par le module objet détenteur n'est pas pertinente.
'     Elle est réservée au dispositif de service XPlanificateur.OnTimeJoue, dont
'     l'exécution est planifiée par une invocation de la méthode PlanifierDans.
   Idt = 0: RaiseEvent Échoit
   End Sub

Et le module XPlanificateur :

Rem. Module de servive effecteur de tâches des objets Planification.
'    NE PAS UTILISER EN PROGRAMMATION APPLICATIVE.
Option Explicit
Private TPlanifications() As Planification, Idt As Long
Public Sub DéplanifierTout()
   Dim P As Long, M As Long
   On Error Resume Next: M = UBound(TPlanifications): If Err Then Exit Sub
   On Error GoTo 0
   For P = 1 To M: Idt = Idt Mod M + 1
      If Not TPlanifications(Idt) Is Nothing Then TPlanifications(Idt).Annuler
      Set TPlanifications(Idt) = Nothing: Next P
   End Sub
Public Function IdtPlanificationLancée(ByVal Source As Planification) As Long
'À usage exclusif du module de classe Planification.
   Dim P As Long, M As Long
   On Error Resume Next: M = UBound(TPlanifications): If Err Then ReDim TPlanifications(1 To 1): M = 1
   On Error GoTo 0
   For P = 1 To M: Idt = Idt Mod M + 1
      If TPlanifications(Idt) Is Nothing Then Exit For
      Next P
   If P > M Then ReDim Preserve TPlanifications(1 To P): Idt = P
   Set TPlanifications(Idt) = Source
   Application.OnTime Source.HeureOT, "'XPlanificateur.OnTimeJoue " & Idt & "'"
   IdtPlanificationLancée = Idt
   End Function
Public Sub AnnulerPlanification(ByVal Idt As Long)
'À usage exclusif du module de classe Planification.
   On Error Resume Next
   Application.OnTime TPlanifications(Idt).HeureOT, "'XPlanificateur.OnTimeJoue " & Idt & "'", Schedule:=False
   Set TPlanifications(Idt) = Nothing
   End Sub
Private Sub OnTimeJoue(ByVal Idt As Long)
'À usage exclusif d'Excel.
   On Error Resume Next
   TPlanifications(Idt).Actionner
   Set TPlanifications(Idt) = Nothing
   End Sub

 

[patricktoulon]

re
moi je ferme le fichier brutalement il redémarre pas tout seul
c'est moi qui suis pas normal ou pas classique alors 🤣 🤣 🤣 🤣

 

[Nico77]

Si, c'est classique: si un classeur est fermé avant qu'une planification par Application.OnTime n'ait été exécutée, le classeur est réouvert pour assumer son exécution. Pour éviter cela, avant fermeture, refaire Application.OnTime avec Shedule:=False en spécifiant la même heure que celle qui avait été spécifiée. Cela implique de la conserver dans une variable globale. Mon objet Planification a des méthode simples:

Rem. Cette classe permet d'exploiter un Application.Ontime dans des objets, via un évènement Échoit.
Option Explicit
Event Échoit() ' Évènement. Se produit à l'échéance du délai.
Private HOT As Date, Idt As Long
Public Sub PlanifierDans(ByVal Délai)
Rem. Méthode. Planifie l'évènement Échoit dans un délai indiquée.
'     Délai: Expression String de la forme "hh:mm:ss" ou bien un nombre de secondes.
'     Remarque: Une éventuelle planification préalable est annulée.
   If Engagé Then XPlanificateur.AnnulerPlanification Idt
   If VarType(Délai) = vbString Then HOT = Now + TimeValue(Délai) Else HOT = Now + TimeSerial(0, 0, Délai)
   Idt = XPlanificateur.IdtPlanificationLancée(Me)
   End Sub
Public Sub Annuler()
Rem. Méthode. Annule la dernière planification s'il en existe une.
   If Idt > 0 Then XPlanificateur.AnnulerPlanification Idt: Idt = 0
   End Sub
Public Function HeureOT() As Date
Rem. Propriété en lecture seule. Dernière heure de planification.
   HeureOT = HOT
   End Function
Public Function Engagé() As Boolean
Rem. Propriété en lecture seule. Condition planification lancée.
   Engagé = Idt > 0
   End Function
Public Sub Actionner()
Rem. Méthode. Déclenche l'évènement Échoit.
'     Son invocation par le module objet détenteur n'est pas pertinente.
'     Elle est réservée au dispositif de service XPlanificateur.OnTimeJoue, dont
'     l'exécution est planifiée par une invocation de la méthode PlanifierDans.
   Idt = 0: RaiseEvent Échoit
   End Sub

Et le module XPlanificateur :

Rem. Module de servive effecteur de tâches des objets Planification.
'    NE PAS UTILISER EN PROGRAMMATION APPLICATIVE.
Option Explicit
Private TPlanifications() As Planification, Idt As Long
Public Sub DéplanifierTout()
   Dim P As Long, M As Long
   On Error Resume Next: M = UBound(TPlanifications): If Err Then Exit Sub
   On Error GoTo 0
   For P = 1 To M: Idt = Idt Mod M + 1
      If Not TPlanifications(Idt) Is Nothing Then TPlanifications(Idt).Annuler
      Set TPlanifications(Idt) = Nothing: Next P
   End Sub
Public Function IdtPlanificationLancée(ByVal Source As Planification) As Long
'À usage exclusif du module de classe Planification.
   Dim P As Long, M As Long
   On Error Resume Next: M = UBound(TPlanifications): If Err Then ReDim TPlanifications(1 To 1): M = 1
   On Error GoTo 0
   For P = 1 To M: Idt = Idt Mod M + 1
      If TPlanifications(Idt) Is Nothing Then Exit For
      Next P
   If P > M Then ReDim Preserve TPlanifications(1 To P): Idt = P
   Set TPlanifications(Idt) = Source
   Application.OnTime Source.HeureOT, "'XPlanificateur.OnTimeJoue " & Idt & "'"
   IdtPlanificationLancée = Idt
   End Function
Public Sub AnnulerPlanification(ByVal Idt As Long)
'À usage exclusif du module de classe Planification.
   On Error Resume Next
   Application.OnTime TPlanifications(Idt).HeureOT, "'XPlanificateur.OnTimeJoue " & Idt & "'", Schedule:=False
   Set TPlanifications(Idt) = Nothing
   End Sub
Private Sub OnTimeJoue(ByVal Idt As Long)
'À usage exclusif d'Excel.
   On Error Resume Next
   TPlanifications(Idt).Actionner
   Set TPlanifications(Idt) = Nothing
   End Sub

Là tu pas perdu voir couler.

Du coup je ne sais pas ou mettre ce que tu a fait. Et va t-il prendre en compte le "Rectangle à coins arrondis 1"?

Merci

 

[Dranreb]

Si vous voulez utiliser ma programmation, le premier code doit être mis dans un nouveau module de classe nommé Planification. Le second dans un module standard nommé XPlanificateur.
C'est quoi votre rectangle à coins arrondi ? Est ce un bouton un peu plus sophistiqué ?
J'ai fait récemment deux classeurs qui reproduisent ça, avec aussi clic du bouton pris en charge dans un module d'objet Worksheet.

 

[Dranreb]

Je pense que j'écrirais ainsi le code du classeur joint au #1 :

Option Explicit
Private HOT As Date
Sub Depart()
   Clign1
   End Sub
Sub Arret()
   If HOT = 0 Then Exit Sub
   Application.OnTime HOT, "Clign1", Schedule:=False
   HOT = 0
   End Sub
Sub Clign1()
   With ActiveSheet.Shapes("Rectangle à coins arrondis 2").Fill.ForeColor
      .RGB = IIf(.RGB = 255, 192255, 255)
      End With
   HOT = Now + TimeSerial(0, 0, 1)
   Application.OnTime HOT, "Clign1"
   End Sub

Mais pour qu'il ne se rouvre pas prévoyez dans ThisWorkbook :

Private Sub Workbook_BeforeClose(Cancel As Boolean)
   Arret
   End Sub

Le module de classe Planification ne serait intéressant que si vous souhaitiez placer la programmation dans le module de la feuille.

 

[Nico77]

Je pense que j'écrirais ainsi le code du classeur joint au #1 :

Option Explicit
Private HOT As Date
Sub Depart()
   Clign1
   End Sub
Sub Arret()
   If HOT = 0 Then Exit Sub
   Application.OnTime HOT, "Clign1", Schedule:=False
   HOT = 0
   End Sub
Sub Clign1()
   With ActiveSheet.Shapes("Rectangle à coins arrondis 2").Fill.ForeColor
      .RGB = IIf(.RGB = 255, 192255, 255)
      End With
   HOT = Now + TimeSerial(0, 0, 1)
   Application.OnTime HOT, "Clign1"
   End Sub

Mais pour qu'il ne se rouvre pas prévoyez dans ThisWorkbook :

Private Sub Workbook_BeforeClose(Cancel As Boolean)
   Arret
   End Sub

Le module de classe Planification ne serait intéressant que si vous souhaitiez placer la programmation dans le module de la feuille.

Merci a vous deux " Dranreb et PatrickToulon " pour cet macro qui me convienne.

Je vais prendre la dernière de Dranreb qui fonctionne parfaitement sur mes ordi.
J'ai fait une petite modif sur cette ligne [ With ActiveSheet.Shapes("Rectangle à coins arrondis 2").Fill.ForeColorWith ]

par: [ ThisWorkbook.Sheets("CodeBarre").Shapes("Rectangle à coins arrondis 1").Fill.ForeColor ]

Un grand merci a vous pour le temps passé.
Bonne journée