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).
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édans la procédureCall Stop_Tempomais ça n'a pas l'effet escompté.Private Sub btnReprendre_Click()
Voici le code (UF et module standard)
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
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 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
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
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
Si mon problème vous paraît clair, peut-être avez-vous une solution ?!
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
D'avance merci pour vos lumières,
Cdt
Partager