Bonjour,

Je ne sais pas trop comment hiérarchiser le code qui suit ; désolé s'il n'est pas dans l'ordre le plus pertinent.

L'idée : si l'utilisateur ne fait aucune action sur les différentes feuilles du classeur pendant 5 min, l'UF ci-dessous s'ouvre et l'utilisateur a 10 sec pour cliquer sur "Laisser ce fichier ouvert", sinon, le classeur se ferme (après enregistrement).

Nom : UF tempo.png
Affichages : 81
Taille : 3,7 Ko

Le problème : Pour des raisons que je n'arrive pas à identifier, il arrive que l'UF se rouvre avant les 5 minutes programmées.

J'ai ajouté
Call Stop_Tempo
dans la procédure
Private Sub btnReprendre_Click()
mais ça n'a pas l'effet escompté.

Voici le code (UF et module standard)

Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3
Private Sub Workbook_SheetselectionChange(ByVal Sh As Object, ByVal Target As Range)
    Call TimeSetting
End Sub
Module standard :

Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3
4
5
6
7
8
9
10
11
12
13
Sub Stop_Tempo()
    On Error Resume Next
    Application.OnTime EarliestTime:=CloseTime, Procedure:="Test_Affichage_UF", Schedule:=False
End Sub
 
Sub Alerte_Sonore()
Dim i As Integer
    On Error GoTo fin
    For i = 1 To 3
        Beep 440, 500                           'note + durée
    Next i
fin:
End Sub
Code UF:

Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
Private Sub btnReprendre_Click()    'correspond au clic sur bouton "laissez ce fichier ouvert"
 
    Call Stop_Tempo                 'j'ai ajouté ça mais ça ne résoud pas le problème d'une relance "intempestive" de la tempo
    TimeSetting
    Me.Hide
End Sub
 
Sub AfficherSecondes()
Dim i As Integer, N As Single
 
    N = (CloseTime - Now) * 24 * 3600
    For i = N To 1 Step -1
        Me.LabelTime = i
        Application.Wait (Now + TimeValue("00:00:01"))
        DoEvents
        On Error GoTo fin           'nota : si clic sur Fermer > Erreur > Fin:
        If Me.Visible = False Then Exit For
    Next i
fin:
End Sub
 
Private Sub UserForm_Activate()
    Call Alerte_Sonore
    TimeSetting 10
    AfficherSecondes
End Sub
Module standard :

Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
Sub TimeSetting(Optional kSec As Integer = 300) 'AJUSTER durée (300 = 5') important !
 
    On Error Resume Next                        'à conserver
    Application.OnTime EarliestTime:=CloseTime, Procedure:="Test_Affichage_UF", Schedule:=False
        CloseTime = DateAdd("s", kSec, Now)
    Application.OnTime EarliestTime:=CloseTime, Procedure:="Test_Affichage_UF", Schedule:=True
End Sub
 
 
Sub Test_Affichage_UF()
 
    If UF_Tempo.Visible = False Then
        UF_Tempo.Show
    Else
        Unload UF_Tempo
        Call Alternative_Close
        ThisWorkbook.Close True                 'True : shunt message "voulez-vous ... ?"
    End If
End Sub
Si mon problème vous paraît clair, peut-être avez-vous une solution ?!
D'avance merci pour vos lumières,
Cdt