Fermer l'Userform si les 4 checkbox sont cochées

Version imprimable

Voir 40 message(s) de cette discussion en une page

Bonjour,

Je code une Userform avec 4 Checkbox.
Voici le code que j'ai pour l'instant, dans le module de l'userform :

Code:

1
2
3
4
5
6
Private Sub UserForm_Initialize()
    OteCroix Me
    If CheckBox1 = "Vrai" And CheckBox2 = "Vrai" And CheckBox3 = "Vrai" And CheckBox4 = "Vrai" Then
    Unload Me
    End If
End Sub

Dans un module standard :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
Option Explicit
 
Declare Function GetWindowLongA Lib "user32" _
(ByVal hwnd As Long, ByVal nIndex As Long) As Long
 
 Declare Function SetWindowLongA Lib "user32" _
(ByVal hwnd As Long, ByVal nIndex As Long, _
ByVal dwNewLong As Long) As Long
 
 Declare Function FindWindowA Lib "user32" _
(ByVal lpClassName As String, ByVal lpWindowName As String) As Long
 
Public Transfer(6) As String
 
Sub OteCroix(UF As UserForm)
Dim hwnd As Long
    'Enlève la croix rouge de l'UF
    hwnd = FindWindowA("Thunder" & IIf(Application.Version Like "8*", "X", "D") _
    & "Frame", UF.Caption)
    SetWindowLongA hwnd, -16, GetWindowLongA(hwnd, -16) And &HFFF7FFFF
End Sub

Je souhaite fermer l'userform lorsque toutes les cases sont cochées.
Sauriez vous comment faire cela ?

Merci,

Code:

1
2
3
If CheckBox1*CheckBox2 * CheckBox3 * CheckBox4 =trueThen
    Unload Me
    End If

14/12/2015, 14h09
Stanler

Bonjour,

Merci pour ta réponse rapide :)

Avec ton code, j'obtiens le même résultat qu'avec le mien. :( J'ai ajouté un espace entre "true" et "then".
14/12/2015, 14h24
Invité

si les case sont cocher alors true sinon false!

que veux tu faire exactement si toutes les case sont cochées,

Code:

If CheckBox1*CheckBox2 * CheckBox3 * CheckBox4 =true Then

si toutes les case sont décochées,

Code:

If CheckBox1*CheckBox2 * CheckBox3 * CheckBox4 =false Then

si une est choché

Code:

If CheckBox1+CheckBox2 + CheckBox3 + CheckBox4 =true Then

si une est décoché,

Code:

If 4+ CheckBox1+CheckBox2 + CheckBox3 + CheckBox4 <>0 Then
14/12/2015, 14h51
Stanler

Si toutes les cases sont cochées alors, je souhaite fermer l'Userform

Si une seule case est cochée alors, ne rien faire
Si une seule case est décochée alors, ne rien faire
Si toutes les cases sont décochées alors, ne rien faire

La seule action est à réaliser si toutes les cases sont cochées

Bonjour,

Dans le même esprit :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
 
Private Sub CheckBox1_Click()
    Fermer
End Sub
 
Private Sub CheckBox2_Click()
    Fermer
End Sub
 
Private Sub CheckBox3_Click()
    Fermer
End Sub
 
Private Sub CheckBox4_Click()
    Fermer
End Sub
 
Sub Fermer()
    If CheckBox1 + CheckBox2 + CheckBox3 + CheckBox4 = -4 Then Unload Me
End Sub

14/12/2015, 16h17
Stanler

1 pièce(s) jointe(s)

C'est astucieux, mais ça ne fonctionne pas non plus :(
Voici mon fichier, ce sera peut être plus simple. Pièce jointe 195240
15/12/2015, 06h46
Theze
Bonjour,

Je n'avais pas fait attention, mais dans "UserForm_Initialize" ça ne peut pas fonctionner car il est en construction et surtout, ça ne sert strictement à rien !
Si c'est vraiment ce que tu veux, il te faut le mettre dans "UserForm_Activate" :
Code:

1 2 3 4 5 6 Private Sub UserForm_Activate() If CheckBox1 + CheckBox2 + CheckBox3 + CheckBox4 = -4 Then Unload Me End Sub

Merci pour ta réponse Theze :D

J'ai testé les codes suivants :

Code:

1
2
3
Private Sub UserForm_Activate()
    If CheckBox1 + CheckBox2 + CheckBox3 + CheckBox4 = -4 Then Unload Me
end sub

Code:

1
2
3
4
5
Private Sub UserForm_Activate()
    If CheckBox1 * CheckBox2 * CheckBox3 * CheckBox4 =true Then
    Unload Me
    End If
end sub

Je n'ai aucun changement, l'userform est toujours visible. Est ce que ca pourrait être lié à ce code que j'ai mis en module standard ? :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
Option Explicit
 
Declare Function GetWindowLongA Lib "user32" _
(ByVal hwnd As Long, ByVal nIndex As Long) As Long
 
 Declare Function SetWindowLongA Lib "user32" _
(ByVal hwnd As Long, ByVal nIndex As Long, _
ByVal dwNewLong As Long) As Long
 
 Declare Function FindWindowA Lib "user32" _
(ByVal lpClassName As String, ByVal lpWindowName As String) As Long
 
Public Transfer(6) As String
 
Sub OteCroix(UF As UserForm)
Dim hwnd As Long
    'Enlève la croix rouge de l'UF
    hwnd = FindWindowA("Thunder" & IIf(Application.Version Like "8*", "X", "D") _
    & "Frame", UF.Caption)
    SetWindowLongA hwnd, -16, GetWindowLongA(hwnd, -16) And &HFFF7FFFF
End Sub

15/12/2015, 12h22
Invité

Bonjour par défaut les CheckBox sont à false ou initialises tu le valeurs à true?
15/12/2015, 14h28
Stanler

1 pièce(s) jointe(s)

Bonjour,

Par défaut les checkbox sont à False, voici une image de la première checkbox. Les autres sont toutes sur le même principe. :
Pièce jointe 195341

A l'ouverture du UserForm les CheckBox son a false comment veux tu valider le test suivant?

Code:

1
2
3
4
5
6
 
Private Sub UserForm_Activate()
    If CheckBox1 * CheckBox2 * CheckBox3 * CheckBox4 =true Then
    Unload Me
    End If
end sub

???
Là ça marche mais sait sens intérêt!

Code:

1
2
3
4
5
Private Sub UserForm_Activate()
    If CheckBox1 * CheckBox2 * CheckBox3 * CheckBox4 +1=true Then
    Unload Me
    End If
end sub

15/12/2015, 18h05
Theze

Les cases étant à False par défaut et le test se faisant sur Activate de la Form, j'ai vraiment de la peine à en comprendre l'intérêt ???
Les codes postés sont dans le cas d'un affichage complet de la Form et d'une intervention de l'utilisateur sur les différentes case à cocher, si toutes cochées, fermeture ! D'où la nécessité d'appeler (dans le cas de mon 1er post) la proc "Fermer" à chaque intervention sur une des cases à cocher !
16/12/2015, 09h10
Stanler

1 pièce(s) jointe(s)

Bonjour,

rdurupt, Theze, l'intérêt de ce UserForm est d'afficher un message jusqu'à ce que l'utilisateur coche toutes les cases. Je fais apparaître ce UserForm à la fin d'une macro assez longue qui traite une base de donnée conséquente. A fin de la macro, il reste une série de choses à faire, qui sont listées par ces fameuses checkbox.

J'ai testé les codes de rdurupt avec la valeur : " Value = True " ; " Value = False " et " Value = "" ". Rien ne se passe.

J'ai mis la valeur des checkbox à "" et j'ai replacé le code de Theze, l'userform s'est bien arrêté lorsque toutes les cases ont été cochées, cependant, lorsque la macro est terminée et affiche l'userform, celui ci s'affiche en étant déjà coché et grisé, comme ceci : Pièce jointe 195405

Or, il devrait s'afficher en non grisé et non coché. Est ce la Valeur des checkbox qui les fait réagir ainsi ? Comment faire pour les faire apparaître blanches et non cochées dans ce cas ? :S
Je suis en train de coder un code pour qu'une case cochée soit verrouillée, et qu'elle soit dévérouillée à chaque appel de l'Userform. Savez vous s'il est possible qu'elle soit grisée lorsqu'elle est verrouillée ?
16/12/2015, 13h20
Invité

Bonjour,
tu as 2 problème:
1) effectivement les case a coché sont grisé!
2) tu ne dis pas de quelle façon elle pourraient être cochées!

si ton formulaire es actif, elle devraient être cochable sauf si tu as définis la propriété Enabled à false!

En effet, mes cases sont grises, et je ne sais pas pourquoi. :( Voici mon code :

Code:

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
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
Private Sub CheckBox1_Click()
    Fermer
    CheckBox1.Locked = True
End Sub
Private Sub CheckBox2_Click()
    Fermer
    CheckBox2.Locked = True
End Sub
Private Sub CheckBox3_Click()
    Fermer
    CheckBox3.Locked = True
End Sub
Private Sub CheckBox4_Click()
    Fermer
    CheckBox4.Locked = True
End Sub
Sub Fermer()
    If CheckBox1 + CheckBox2 + CheckBox3 + CheckBox4 = -4 Then
    Unload Me
    CreateObject("Wscript.shell").PopUp "Vous avez fini le traitement." & Chr(13) & "Merci et bravo, " & Application.UserName, 1, "Fin du programme"
    Application.CutCopyMode = False
    End If
End Sub
Private Sub OptionButton1_Click()
With Application
    .ScreenUpdating = False
    .Calculation = xlCalculationManual
    .DisplayStatusBar = False
    .StatusBar = True
    .DisplayAlerts = False
End With
    Sheets("TabCroDyn").Select
        If Not Sheets("TabCroDyn").AutoFilterMode Then Sheets("TabCroDyn").Range("I3").AutoFilter
            If Sheets("Feuil1").FilterMode = True Then Sheets("Feuil1").ShowAllData
    Sheets("TabCroDyn").Range("I3").CurrentRegion.AutoFilter Field:=2, Criteria1:=RGB(255, 199, 206), Operator:=xlFilterCellColor
With Application
    .ScreenUpdating = True
    .Calculation = xlCalculationAutomatic
    .DisplayStatusBar = True
    .CutCopyMode = False
    .StatusBar = False
    .DisplayAlerts = True
End With
Sheets("TabCroDyn").Select
End Sub
Private Sub OptionButton2_Click()
With Application
    .ScreenUpdating = False
    .Calculation = xlCalculationManual
    .DisplayStatusBar = False
    .StatusBar = True
    .DisplayAlerts = False
End With
    Sheets("Feuil1").Select
        If Not Sheets("Feuil1").AutoFilterMode Then Sheets("Feuil1").Range("A1").AutoFilter
            If Sheets("Feuil1").FilterMode = True Then Sheets("Feuil1").ShowAllData
    Sheets("Feuil1").Range("A1").AutoFilter Field:=1, Criteria1:="=0"
    Sheets("Feuil1").Range("A1").AutoFilter Field:=27, Criteria1:="<>HS"
With Application
    .ScreenUpdating = True
    .Calculation = xlCalculationAutomatic
    .DisplayStatusBar = True
    .CutCopyMode = False
    .StatusBar = False
    .DisplayAlerts = True
End With
Sheets("Feuil1").Range("A1").Select
End Sub
Private Sub OptionButton3_Click()
With Application
    .ScreenUpdating = False
    .Calculation = xlCalculationManual
    .DisplayStatusBar = False
    .StatusBar = True
    .DisplayAlerts = False
End With
    Sheets("Feuil1").Select
        If Not Sheets("J de P").AutoFilterMode Then Sheets("Feuil1").Range("A1").AutoFilter
            If Sheets("J de P").FilterMode = True Then Sheets("Feuil1").ShowAllData
    Sheets("Feuil1").Range("A1").AutoFilter Field:=101, Criteria1:="=#N/A"
    Sheets("Feuil1").Range("A1").AutoFilter Field:=27, Criteria1:="<>HS"
With Application
    .ScreenUpdating = True
    .Calculation = xlCalculationAutomatic
    .DisplayStatusBar = True
    .CutCopyMode = False
    .StatusBar = False
    .DisplayAlerts = True
End With
Sheets("Feuil1").Range("CZ1").Select
End Sub
Private Sub OptionButton4_Click()
With Application
    .ScreenUpdating = False
    .Calculation = xlCalculationManual
    .DisplayStatusBar = False
    .StatusBar = True
    .DisplayAlerts = False
End With
    Sheets("J de P").Select
        If Not Sheets("Feuil1").AutoFilterMode Then Sheets("J de P").Range("A1").AutoFilter
            If Sheets("Feuil1").FilterMode = True Then Sheets("J de P").ShowAllData
With Application
    .ScreenUpdating = True
    .Calculation = xlCalculationAutomatic
    .DisplayStatusBar = True
    .CutCopyMode = False
    .StatusBar = False
    .DisplayAlerts = True
End With
Sheets("Feuil1").Range("A1").Select
End Sub
Private Sub UserForm_Activate()
OteCroix Me
    With UserForm1
        .CheckBox1.Locked = False
        .CheckBox2.Locked = False
        .CheckBox3.Locked = False
        .CheckBox4.Locked = False
    End With
End Sub

Les cases sont cochables à la souris simplement en cliquant dessus.
Pour mes cases, même si elles sont grisées, je peux cliquer dessus et les cocher en les dégrisant.
Je suis loin d'être un expert en VBA, mais mon bidouillage fonctionne sauf pour l'esthétique de la checkbox :/

16/12/2015, 14h53
Invité

Salut,

Il y a une option TriState (3 états : True, False et Null) qui permet de mettre la valeur à Null (En effet, le type de donnée de .Value est Variant), et dans cette état, la case est grisé mais son état reste modifiable.
16/12/2015, 15h01
Theze

Citation:

Or, il devrait s'afficher en non grisé et non coché.

et bien, quelque part dans ton code tu définis la propriété "Enabled" à False ce qui les grise et tu définis leur propriété "Value" à True ce qui les coche ! Quelle valeur a la propriété "TripleState" ? Elle doit être à False pour n'avoir que 2 possibilités, cochée ou non ! Si la propriété est à True, elles peuvent être grisées et cochées !

Merci à vous deux pour votre retour.

TripleState est à "False" sur toutes les checkbox.

Serait-ce Otecroix qui fait cela ? Voici son code :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
Option Explicit
 
Declare Function GetWindowLongA Lib "user32" _
(ByVal hwnd As Long, ByVal nIndex As Long) As Long
 
 Declare Function SetWindowLongA Lib "user32" _
(ByVal hwnd As Long, ByVal nIndex As Long, _
ByVal dwNewLong As Long) As Long
 
 Declare Function FindWindowA Lib "user32" _
(ByVal lpClassName As String, ByVal lpWindowName As String) As Long
 
Public Transfer(6) As String
 
Sub OteCroix(UF As UserForm)
Dim hwnd As Long
    'Enlève la croix rouge de l'UF
    hwnd = FindWindowA("Thunder" & IIf(Application.Version Like "8*", "X", "D") _
    & "Frame", UF.Caption)
    SetWindowLongA hwnd, -16, GetWindowLongA(hwnd, -16) And &HFFF7FFFF
End Sub

16/12/2015, 15h08
Theze

j'allais à l'instant te dire de mettre "OteCroix Me" en commentaire pour tester !

Voir 40 message(s) de cette discussion en une page