XL 2016 RESOLU _ Reset le minuteur si Userform Actif et activité sur Userform

[BENAM69]

Bonjour

J'espère que vous allez bien.

J'aimerai savoir si c'est possible de redémarrer le minuteur/compteur a chaque fois que l'userform est actif ? Et s'il est possible de dire à chaque fois au miniteur de redémarrer s'il y a de l'activité sur l'userform (Ex : clique sur une combox, écriture/modification dans un combox, clique sur une liste déroulante de l'userform etc...).

En effet, j'ai le minuteur qui fonctionne très bien, quand je suis dans le classeur, que je clique sur une cellule, modifie par exemple. Mais quand il s'agit de l'userform rien ne fonctionne.
Quelqu'un aurait une idée ?


ThisWorkbook :

Private Sub Workbook_Open()
    StartTimer ' Démarrer le minuteur lorsque le classeur est ouvert
End Sub

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
    ResetTimer ' Réinitialiser le minuteur lorsqu'une sélection est modifiée
End Sub

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
    ResetTimer ' Réinitialiser le minuteur lorsqu'une cellule est modifiée
End Sub

Private Sub Workbook_SheetActivate(ByVal Sh As Object)
    ResetTimer ' Réinitialiser le minuteur lorsqu'une feuille est activée
End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)
    On Error Resume Next
    Application.OnTime Now + TimeValue("00:00:15"), "CheckActivity", , False ' Désactive le minuteur avant la fermeture du classeur
End Sub

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
    ResetTimer ' Réinitialiser le minuteur avant de sauvegarder le classeur
End Sub

Dans Userform :

' Gestionnaire d'événement pour les UserForms ouverts
Private Sub UserForm_Activate()
    ResetTimer ' Réinitialiser le minuteur lorsqu'un UserForm est activé
End Sub

Dans Module :

Dim IsTimerRunning As Boolean
Dim TimerStartTime As Double


Sub StartTimer()
    IsTimerRunning = True
    TimerStartTime = Now
    Application.OnTime Now + TimeValue("00:00:15"), "CheckActivity" ' Démarre le minuteur
End Sub

Sub ResetTimer()
    IsTimerRunning = False
End Sub

Sub CheckActivity()
    If IsTimerRunning And Now >= TimerStartTime + TimeValue("00:00:15") Then
        ' Sauvegarde automatique et fermeture du classeur en cas d'inactivité
        ThisWorkbook.Save
        ThisWorkbook.Close
    Else
        StartTimer ' Redémarre le minuteur si une activité est détectée
    End If
End Sub

Sub UserForm()

UserForm1.Show

End Sub

Voici en PJ mon fichier

Je ne sais pas si ma demande est claire. Merci de votre aide

 

[Dudu2]

Bonsoir,
C'est quoi le but de ta manip ?
Tu parles...

de redémarrer le minuteur/compteur a chaque fois que l'userform est actif

mais tu le redémarres aussi sur des évènements feuille variés.
Alors de quoi s'agit-il au final ? Quel est l'objectif de tout ça ?

 

[BENAM69]

Oui en effet, étant donné que le fichier est partagé à plusieurs sites de production. Certains responsables l'ouvrent et oublient de le refermer. De ce fait, l'utilisation est en lecture seule et non en modification. Vu que sur le fichier il existe des userform, quand la personne ouvre un userform cela ne prend pas en compte quand il y a une activité le compteur continue. Et ne se Réinitialise pas

 

[Dudu2]

Et donc, le but de la manip est ... ?

 

[Dudu2]

De fermer le classeur s'il n'est pas utilisé. OK !
Pourquoi ne pas le dire !?

 

[Dudu2]

J'ai simplifie le code. Je ne vois pas pourquoi ça ne marcherait pas avec le UserForm.

 

[Dranreb]

Bonsoir.
J'ai un type d'objet Planification si ça vous intéresse, qui utilise un modules standard XPlanificateur.
Module de classe Planification :

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 MéthodeRéservéeÀOnTimeJoue()
Rem. ——— Méthode. Décrète l'évènement Échoit.
'     Son utilisation par le code détenteur de l'exemplaire n'est pas pertinente.
'     Elle est réservé à la procédure XPlanification.OnTimeJoue planifiée par Application.OnTime.
   Idt = 0: RaiseEvent Échoit
   End Sub

Module standard 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

Rem. Ne devrait pas servir en principe. À tout hasard: désactive tous les objets Planification.
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

Rem. Ne pas utiliser ces autres procédures: elles sont à l'usage exclusif des objets Planification.
Public Function IdtPlanificationLancée(ByVal Source As Planification) As Long
   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)
   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)
   On Error Resume Next
   TPlanifications(Idt).MéthodeRéservéeÀOnTimeJoue
   Set TPlanifications(Idt) = Nothing
   End Sub

 

[Dranreb]

J'en ai équipé votre classeur.

 

[Dudu2]

Bonjour à tous,
Pourquoi je n'arrive pas à traiter un évènement dans un Module ?!

Au niveau Module Private WithEvents CL1 As CL est rejeté alors que la doc MS indique:
Vous ne pouvez utiliser WithEvents qu’au niveau de la classe ou du module.

 

[Dranreb]

J'ignore pourquoi les procédures de prise en charges d'évènements ne peuvent être programmées que dans un module objet. Mais cela admis, il est logique que l'attribut WithEvents ne puisse être employé dans un module standard.

 

[Dudu2]

Même avec un AddHandler, syntaxe de MS, ça ne fonctionne pas !

 

[Dudu2]

Bon ça n'a pas d'importance, juste un test...

 

[Dranreb]

C'est apparemment de la documentation pour Visual Basic Studio qui, de VB6, a évolué en quelque chose qui ne me plait d'ailleurs pas. VBA en est resté beaucoup plus proche.

 

[BENAM69]

Merci Dudu2, donc oui cela fonctionne.
C'était probablement un bug du fichier excel.

Belle journée à toi et Bravo encore !!

 

[Dranreb]

Bonjour.
J'ai un peu étoffé ma version.