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 :
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 |