Discussion :

[MarcelG]

Bonsoir le forum,

Mon classeur détient 2 formulaires avec chacun un bouton clignotant pendant une suite d'instructions.

Le problème est que si j'active l'un des 2 boutons alors le classeur se ferme inopinément sans boîte de dialogue de sauvegarde ni quelque alerte que ce soit.

Voici les codes

Module nommé "Clignotant"

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
Option Explicit
 
Public hTimer As Long
 
Public Const TIME_PERIODIC = &H1
Public Const TIME_CALLBACK_FUNCTION = &H0
 
Public Declare Function timeSetEvent Lib "winmm.dll" (ByVal uDelay As Long, ByVal uResolution As Long, ByVal lpFunction As Long, ByVal dwUser As Long, ByVal uFlags As Long) As Long
Public Declare Function timeKillEvent Lib "winmm.dll" (ByVal uID As Long) As Long
 
Sub TimerEvent1(ByVal uID As Long, ByVal uMsg As Long, ByVal dwUser As Long, ByVal dw1 As Long, ByVal dw2 As Long)
On Error Resume Next
 
    With MONUSF1.Btn_Traitement
            .Visible = Not .Visible
    End With
End Sub
 
Sub TimerEvent2(ByVal uID As Long, ByVal uMsg As Long, ByVal dwUser As Long, ByVal dw1 As Long, ByVal dw2 As Long)
On Error Resume Next
 
    With MONUSF2.Btn_Valid
            .Visible = Not .Visible
    End With
End Sub

Dans le code de MONUSF1

Pour lévènement Clic du bouton Btn_Traitement

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
Call TimerStart1
 
'une suite d'instructions et de macros
 
Call TimerStop1

et dans ce même module

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
Sub TimerStart1()
    Dim frequenceTime As Long
    frequenceTime = 250
    hTimer = timeSetEvent(frequenceTime, 0, AddressOf TimerEvent1, 0, TIME_PERIODIC Or TIME_CALLBACK_FUNCTION)
End Sub
 
Sub TimerStop1()
    timeKillEvent hTimer
    Btn_Valid.Visible = True
End Sub

Idem pour l'autre uerform (indice 2 pour TimerEvent...)

Dès que j'active l'un des 2 boutons, le fichier se ferme ?!!!!!

D'avance, merci pour vos lumières.

[PMO2017]

Bonjour,

La demande est-elle toujours d'actualité ?

[MarcelG]

Bonjour PMO, Bonjour le Forum,

Beeeen Oui!

Merci.

[PMO2017]

Bonjour,

J'ai trouvé une solution qui semble fonctionner.
J'ai été obligé de faire les choses suivantes pour éviter certains dysfonctionnements :
1) différer le traitement lors du clic sur CommandButton
2) désactiver la croix de fermeture durant le cours du traitement puis la réactiver à son arrêt
3) le clignotement passe par un changement de couleur du bouton plutôt que d'agir sur sa propriété Visible (lorsque le bouton est Visible=False cela active la fenêtre du UserForm, si l'utilisateur clique sur le bouton il clique sur le UserForm)
J'en oublie peut être.

Il faudra adapter le code pour que l'arrêt du clignotement se fasse à la fin des procédures "Traitementx". Pour mon développement, c'est le clic sur UserForm qui provoque l'arrêt.

J'ai construit :
1) 2 UserForms (Userform1 et UserForm2) avec chacun un CommandButton1
2) le code standard est dans 2 modules Standard mais vous pouvez les réunir dans un seul module (je voyais plus clair comme cela)
*****

Code à copier dans la fenêtre de code de UserForm1

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
Private Sub CommandButton1_Click()
'### Nécessité de terminer cette procédure avant de commencer le traitement ###
If Not EnCours1 Then Application.OnTime Now + TimeValue("00:00:00"), "Traitement1"
End Sub
 
Private Sub UserForm_Click()
If EnCours1 Then
  Call EtatCroixFermeture(Me, True)
  Call TimerStop1
  EnCours1 = False
End If
End Sub
 
Private Sub UserForm_Activate()
Me.Left = 100
Me.Top = 250
Me.Caption = "Clic UserForm = Stop clignotement"
End Sub

Code à copier dans la fenêtre de code de UserForm2 (c'est presque le même que ci-dessus)

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
Private Sub CommandButton1_Click()
'### Nécessité de terminer cette procédure avant de commencer le traitement ###
If Not EnCours2 Then Application.OnTime Now + TimeValue("00:00:00"), "Traitement2"
End Sub
 
Private Sub UserForm_Click()
If EnCours2 Then
  Call EtatCroixFermeture(Me, True)
  Call TimerStop2
  EnCours2 = False
End If
End Sub
 
Private Sub UserForm_Activate()
Me.Left = 400
Me.Top = 250
Me.Caption = "Clic UserForm = Stop clignotement"
End Sub

Code à copier dans un 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
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
'/// APIs : Déclarations et constantes
Declare Function timeSetEvent& Lib "winmm.dll" ( _
  ByVal uDelay As Long, ByVal uResolution As Long, ByVal lpFunction As Long, _
  ByVal dwUser As Long, ByVal uFlags As Long)
Declare Function timeKillEvent& Lib "winmm.dll" (ByVal uID As Long)
Const TIME_PERIODIC = &H1
Const TIME_CALLBACK_FUNCTION = &H0
 
'/// Portée au niveau Projet
Public EnCours1 As Boolean
Public EnCours2 As Boolean
 
'/// Portée au niveau Module
Dim hTimer1 As Long
Dim hTimer2 As Long
Dim Couleur1 As Long
Dim Couleur2 As Long
 
'**************
Sub LaunchUSFs()
UserForm1.Show vbModeless
UserForm2.Show vbModeless
End Sub
 
'######################################################
'######################################################
'######################################################
Sub TimerEvent1(ByVal uID As Long, ByVal uMsg As Long, ByVal dwUser As Long, ByVal dw1 As Long, ByVal dw2 As Long)
Static bool As Boolean
With UserForm1.CommandButton1
  If bool Then
    .BackColor = 12106214
  Else
    .BackColor = 12379351
  End If
End With
bool = Not bool
End Sub
 
Sub TimerStart1(Optional dummy As Byte)
Dim frequenceTime As Long
Couleur1 = UserForm1.CommandButton1.BackColor
frequenceTime = 250
hTimer1 = timeSetEvent(frequenceTime, 0, AddressOf TimerEvent1, 0, TIME_PERIODIC Or TIME_CALLBACK_FUNCTION)
End Sub
 
Sub TimerStop1(Optional dummy As Byte)
If hTimer1 > 0 Then
  timeKillEvent hTimer1
  UserForm1.CommandButton1.BackColor = Couleur1
End If
End Sub
 
'######################################################
'######################################################
'######################################################
Sub TimerEvent2(ByVal uID As Long, ByVal uMsg As Long, ByVal dwUser As Long, ByVal dw1 As Long, ByVal dw2 As Long)
Static bool As Boolean
With UserForm2.CommandButton1
  If bool Then
    .BackColor = 10288887
  Else
    .BackColor = 15849925
  End If
End With
bool = Not bool
End Sub
 
Sub TimerStart2(Optional dummy As Byte)
Dim frequenceTime As Long
Couleur2 = UserForm2.CommandButton1.BackColor
frequenceTime = 250
hTimer2 = timeSetEvent(frequenceTime, 0, AddressOf TimerEvent2, 0, TIME_PERIODIC Or TIME_CALLBACK_FUNCTION)
End Sub
 
Sub TimerStop2(Optional dummy As Byte)
If hTimer2 > 0 Then
  timeKillEvent hTimer2
  UserForm2.CommandButton1.BackColor = Couleur2
End If
End Sub
 
'######################################################
'######################################################
'######################################################
Sub Traitement1(Optional dummy As Byte)
If Not EnCours1 Then
  Call EtatCroixFermeture(UserForm1, False)
  Call TimerStart1
  EnCours1 = True
End If
 
'une suite d'instructions et de macros
End Sub
 
Sub Traitement2(Optional dummy As Byte)
If Not EnCours2 Then
  Call EtatCroixFermeture(UserForm2, False)
  Call TimerStart2
  EnCours2 = True
End If
 
'une suite d'instructions et de macros
End Sub

Code à copier dans un autre 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
27
28
29
30
Declare Function SetForegroundWindow& Lib "user32" ( _
  ByVal hwnd As Long)
Declare Function ShowWindow& Lib "user32" ( _
  ByVal hwnd As Long, ByVal nCmdShow As Long)
Declare Function GetSystemMenu& Lib "user32" ( _
  ByVal hwnd As Long, ByVal bRevert As Long)
Declare Function RemoveMenu& Lib "user32" ( _
  ByVal hMenu As Long, ByVal nPosition As Long, ByVal wFlags As Long)
Declare Function FindWindowA& Lib "user32" ( _
  ByVal lpClassName As String, ByVal lpWindowName As String)
 
Const SW_SHOW = &H5
Const SC_CLOSE = &HF060&
Const MF_BYCOMMAND = &H0&
 
Sub EtatCroixFermeture(USF As Object, CroixFermeture As Boolean)
Dim hSysMenu As Long
Dim MeHwnd As Long
MeHwnd = FindWindowA(vbNullString, USF.Caption)
If MeHwnd > 0 Then
  hSysMenu = GetSystemMenu(MeHwnd, CroixFermeture)
  If Not CroixFermeture Then RemoveMenu hSysMenu, SC_CLOSE, MF_BYCOMMAND
'### Bascules entre fenêtres pour rafraîchir la fenêtre du UserForm (USF.Repaint ne fonctionne pas) ###
  SetForegroundWindow Application.hwnd
  ShowWindow Application.hwnd, SW_SHOW
  SetForegroundWindow MeHwnd
  ShowWindow MeHwnd, SW_SHOW
'#####################################################################################################
End If
End Sub

Ouf ! c'est fastidieux.
Je mets le classeur exemple en pièce jointe pour plus de facilité.
Qu'est-ce que cela donne chez vous ?