XL 2016 Application.OnTime ne s'arrête pas, fichier se réouvre tout seul

Djaroule

XLDnaute Nouveau
Bonjour à toutes et tous,

Présentation rapide du fonctionnement de ma macro :

J'utilise un timer pour fermer et enregistrer un fichier au bout de 15 minutes d'ouverture.
J'ai un bouton qui s'afficher vert les 5 premières minutes, ensuite il passe orange puis rouge toutes les 5 minutes. Passé ce délai, le fichier s'enregistre et se ferme.
Il est possible de cliquer sur ce bouton à tout moment afin de remettre à zéro la tempo (il repasse vert).

Ce qui ne fonctionne pas :

Après fermeture du fichier, que ce soit de façon manuelle ou grâce au minuteur, le fichier se réouvre tout seul.
Actuellement, la seule façon de contourner le problème est de fermer Excel.

Merci d'avance pour votre aide !



Voici ce que j'ai dans THIS WORKBOOK :

Private Sub Workbook_Open()

'activation de la feuille SOMMAIRE

Sheets("SOMMAIRE").Activate

MsgBox ("Merci de vous identifier avant de commencer. Veuillez sélectionner VOTRE SERVICE puis VOTRE NOM.")

LancerTimer

MsgBox ("Afin d'éviter une ouverture prolongée de ce fichier et de bloquer vos collègues, veuillez noter l'arrivée d'un bouton de couleur en haut à droite du SOMMAIRE. Il reste VERT pendant 5 minutes, puis ORANGE pendant 5 minutes, puis ROUGE pendant 5 minutes. Passé ce délai, le catalogue va s'enregistrer et se fermer automatiquement. Si les 15 minutes ne suffisent pas, cliquer sur ce bouton pour qu'il repasse VERT et vous repartirez pour 15 minutes de shopping !")

'MISE A ZERO DU SERVICE

Sheets("SOMMAIRE").Range("D1").Value = ""

'MISE A ZERO DU SERVICE

Sheets("SOMMAIRE").Range("H1").Value = ""

'fermeture du fichier catalogue MPD

Workbooks("CATALOGUE MPD.xlsm").Close SaveChanges:=False

End Sub

'arrêt timer avant fermeture du fichier

Private Sub Workbook_BeforeClose(Cancel As Boolean)

ArretTimerTous

End Sub






Voici ce que j'ai dans un module :

' Variables globales du Timer
Dim Lheure1 As Double
Dim Lheure2 As Double
Dim Lheure3 As Double
Public Const Delai1 = "00:05:00"
Public Const Delai2 = "00:05:00"
Public Const Delai3 = "00:05:00"

'=================================================================================================================
' Gestion du Timer
'=================================================================================================================
Sub LancerTimer()
ArretTimerTous

' Forme fond vert

'Sheets("SOMMAIRE").Activate

'With ActiveSheet.Shapes("Alerteur").Fill
With Sheets("SOMMAIRE").Shapes("Alerteur").Fill
.Visible = msoTrue
.ForeColor.RGB = RGB(0, 176, 80)
.Transparency = 0
.Solid
End With

' la ligne suivante va lancer le 1er ExecutionTimer
Lheure1 = Now + TimeValue(Delai1)
Application.OnTime Lheure1, "ExecutionTimer1", , True

End Sub

Public Sub ArretTimer(Lheure, ExecutionTimer)
' Pour arrêter le timer
On Error Resume Next
Application.OnTime Lheure, ExecutionTimer, , False
End Sub

Public Sub ExecutionTimer1()
''ArretTimer Lheure1, "ExecutionTimer1"
On Error Resume Next
Application.OnTime Lheure1, "ExecutionTimer1", , False

' Forme fond orange
'With ActiveSheet.Shapes("Alerteur").Fill
With Sheets("SOMMAIRE").Shapes("Alerteur").Fill
.Visible = msoTrue
.ForeColor.RGB = RGB(255, 192, 0)
.Transparency = 0
.Solid
End With

' la ligne suivante va lancer la procédure le 2eme ExecutionTimer
Lheure2 = Now + TimeValue(Delai2)
Application.OnTime Lheure2, "ExecutionTimer2", , True

End Sub

Public Sub ExecutionTimer2()
''ArretTimer Lheure2, "ExecutionTimer2"

On Error Resume Next
Application.OnTime Lheure2, "ExecutionTimer2", , False

' Forme fond rouge
' With ActiveSheet.Shapes("Alerteur").Fill
With Sheets("SOMMAIRE").Shapes("Alerteur").Fill
.Visible = msoTrue
.ForeColor.RGB = RGB(255, 0, 0)
.Transparency = 0
.Solid
End With

' la ligne suivante va lancer la procédure le 3eme ExecutionTimer
Lheure3 = Now + TimeValue(Delai3)
Application.OnTime Lheure3, "ExecutionTimer3", , True

End Sub

Public Sub ExecutionTimer3()
'ArretTimer Lheure3, "ExecutionTimer3"
On Error Resume Next
Application.OnTime Lheure3, "ExecutionTimer3", , False
ActiveWorkbook.Save
ActiveWorkbook.Close
End Sub

Sub ArretTimerTous()

On Error Resume Next
Application.OnTime Lheure1, "ExecutionTimer1", , False
Application.OnTime Lheure2, "ExecutionTimer2", , False
Application.OnTime Lheure3, "ExecutionTimer3", , False


End Sub
 

Dranreb

XLDnaute Barbatruc
Bonjour.
J'ai un dispositif de décompte qui pourrait vous intéresser dans ce classeur

Édition. Remarque: Impossible de voir ce qui cloche dans votre code reproduit sans les balises mises par l'icone Code, au lieu de joindre une version épurée de votre classeur.
 

Pièces jointes

  • Progression.xlsm
    184 KB · Affichages: 5
Dernière édition:

mapomme

XLDnaute Barbatruc
Supporter XLD
Bonjour à tous,

Votre code me parait un peu long et compliqué.
Un exemple de ce qui pourrait être fait. Les constantes en début du module1 définissent les différentes durées (pour le fichier joint les constantes sont 20 s pour le vert, 15 s pour l'orange et 10 s pour le rouge). Il n'y a qu'un seul décompte qui en fonction de la durée écoulée procède à des actions différentes.
 

Pièces jointes

  • Djaroule- Decompte- v1.xlsm
    23.1 KB · Affichages: 15
Dernière édition:

Djaroule

XLDnaute Nouveau
Bonjour "mapomme",

Merci pour votre aide. J'ai adapté votre solution dans mon fichier (sans quasiment rien changer), et dès l'ouverture du fichier je me retrouve immédiatement dans le cas "temps épuisé".

Je ne comprend pas votre ligne :

duree = Int((Now() - Tdebut) * 24 * 60 * 60) 'durée écoulé depuis le début

Je pense que mon problème vient d'ici. Y a-t-il des valeurs de durée orange/vert/rouge à respecter ?
 

Djaroule

XLDnaute Nouveau
Ne cherchez pas, j'ai trouvé d'ou viens le problème.
La commande "Declencher" ne se fait pas car je ferme un autre fichier et je n'arrive pas à réactiver ce classeur...
La ligne Workbooks("réservé MPD.xlsm").Activate ne fonctionne pas !


Option Explicit

Private Sub Workbook_Open()

'fermeture du fichier catalogue MPD
Workbooks("CATALOGUE MPD.xlsm").Close SaveChanges:=False

'activation du classeur réservé MPD
Workbooks("réservé MPD.xlsm").Activate

'activation de la feuille SOMMAIRE
Sheets("SOMMAIRE").Activate

'MISE A ZERO DU SERVICE
Sheets("SOMMAIRE").Range("D1").Value = ""

Declencher

End Sub
 

Djaroule

XLDnaute Nouveau
Je viens de m'apercevoir d'un problème avec votre fichier.
Si j'ouvre un autre fichier pendant que votre timer fonctionne, j'ai une erreur (Excel ne trouve plus la feuille ou se situe le voyant "compteur").
Avez-vous un moyen d'éviter cela ?
 

Discussions similaires