Limitation du nombre de CheckBox cochables

Version imprimable

29/06/2016, 00h31
Patouillou

Limitation du nombre de CheckBox cochables

Bonsoir,

J'ai beau chercher depuis maintenant 2h, je ne trouve pas ..
Pourtant ma question est simple, je veux imposer une limite de checkbox cochable à 10.
En effet, j'ai dans un userform, 16 checkbox, mais l'utilisateur ne doit pouvoir en cocher que 10...

Je suis certain qu'il est possible de faire cela mais je ne sais comment...
Merci à vous et bonne soirée !

Bonjour,

À première vue et non testé:

dans un module standard:
Code:

1 2 3 4 5 6 7 8 public compteur Sub FautBienTesteDeNePasDépasserDix compteur = compteur + 1 if compteur > 10 then msgbox("Vous excédez la limite de 10 sélections") ajouter le code pour continuer le programme ou remplacer une sélection end if end sub
Dans l'événement qui va bien dans le module de code de chaque CheckBox. Je suppose, je dis bien suppose de AfterUpdate devrait aller mieux que click
Code:

1 2 3 Private Sub CheckBox1_AfterUpdate() FautBienTesteDeNePasDépasserDix End Sub
Tu vas probablement devoir broder un peu...

Salut, un embryon perfectible à adapter à ton contexte pour le décompte. Prévoir un module de classe pour tes checkboxes.

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
Option Explicit
 
Dim cpt As Long
 
Private Sub Tst()
Dim Ctrl As Control
    cpt = 0
    For Each Ctrl In UserForm1.Controls
        If TypeOf Ctrl Is MSForms.CheckBox Then
            If Ctrl.Value = True Then
                cpt = cpt + 1
            End If
        End If
    Next Ctrl
    Application.StatusBar = cpt
End Sub
 
Private Sub CheckBox1_Change()
    Tst
End Sub
 
Private Sub CheckBox2_Change()
    Tst
End Sub

3 pièce(s) jointe(s)

Bonjour,
Autre idée :
code dans l'usf

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
Private Sub UserForm_Activate() 'ou Initialize
Dim Cl As C_CheckBox
 
Set Collect = New Collection
 For Each Ctrl In Me.Controls
    'verifie s'il s'agit d'un CheckBox
    If TypeOf Ctrl Is MSForms.CheckBox Then
      Set Cl = New C_CheckBox
      Set Cl.groupeCheckBox = Ctrl
      Collect.Add Cl
    End If
Next Ctrl
 
End Sub

code dans un module standard

Code:

1
2
Public Collect As Collection
Public Ctrl As Control, Nb As Integer

code dans un module de classe qu'on nomme C_CheckBox

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
Option Explicit
 
Public WithEvents groupeCheckBox As MSForms.CheckBox
 
Private Sub groupeCheckBox_Click()
Nb = 0
For Each Ctrl In UserForm1.Controls
  If TypeOf Ctrl Is MSForms.CheckBox And Ctrl = True Then
        Nb = Nb + 1
        If Nb > 10 Then MsgBox "Limité à 10": UserForm1.ActiveControl = False
  End If
Next
End Sub

Pièce jointe 214223 Pièce jointe 214224

Bonjour,

Il est possible d'utiliser un module de classe afin d'avoir un appel commun mais là, j'ai fais simple (une proc pour chaque case à cocher). Sur "BeforeUpdate" afin de pouvoir annuler la coche et décocher puis re-cocher si trompé :

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
 
Private Sub CheckBox1_BeforeUpdate(ByVal Cancel As MSForms.ReturnBoolean)
    Max10 Cancel
End Sub
Private Sub CheckBox2_BeforeUpdate(ByVal Cancel As MSForms.ReturnBoolean)
    Max10 Cancel
End Sub
Private Sub CheckBox3_BeforeUpdate(ByVal Cancel As MSForms.ReturnBoolean)
    Max10 Cancel
End Sub
Private Sub CheckBox4_BeforeUpdate(ByVal Cancel As MSForms.ReturnBoolean)
    Max10 Cancel
End Sub
Private Sub CheckBox5_BeforeUpdate(ByVal Cancel As MSForms.ReturnBoolean)
    Max10 Cancel
End Sub
Private Sub CheckBox6_BeforeUpdate(ByVal Cancel As MSForms.ReturnBoolean)
    Max10 Cancel
End Sub
Private Sub CheckBox7_BeforeUpdate(ByVal Cancel As MSForms.ReturnBoolean)
    Max10 Cancel
End Sub
Private Sub CheckBox8_BeforeUpdate(ByVal Cancel As MSForms.ReturnBoolean)
    Max10 Cancel
End Sub
Private Sub CheckBox9_BeforeUpdate(ByVal Cancel As MSForms.ReturnBoolean)
    Max10 Cancel
End Sub
Private Sub CheckBox10_BeforeUpdate(ByVal Cancel As MSForms.ReturnBoolean)
    Max10 Cancel
End Sub
Private Sub CheckBox11_BeforeUpdate(ByVal Cancel As MSForms.ReturnBoolean)
    Max10 Cancel
End Sub
Private Sub CheckBox12_BeforeUpdate(ByVal Cancel As MSForms.ReturnBoolean)
    Max10 Cancel
End Sub
Private Sub CheckBox13_BeforeUpdate(ByVal Cancel As MSForms.ReturnBoolean)
    Max10 Cancel
End Sub
Private Sub CheckBox14_BeforeUpdate(ByVal Cancel As MSForms.ReturnBoolean)
    Max10 Cancel
End Sub
Private Sub CheckBox15_BeforeUpdate(ByVal Cancel As MSForms.ReturnBoolean)
    Max10 Cancel
End Sub
 
Private Sub CheckBox16_BeforeUpdate(ByVal Cancel As MSForms.ReturnBoolean)
    Max10 Cancel
End Sub
 
Sub Max10(Annuler As MSForms.ReturnBoolean)
 
    Dim Chk As MSForms.CheckBox
    Dim I As Integer
 
    For Each Chk In Me.Controls
        If Chk.Value = True Then I = I + 1
    Next Chk
 
    If I >= 10 Then Annuler = True
 
End Sub

29/06/2016, 13h03
Patouillou

1 pièce(s) jointe(s)

Bonjour à vous et merci pour vos réponse,

J'ai regarder et essayé la solution de casefayere et celle-ci fonctionnait très bien dans le fichier qu'il a fourni.
Cependant , en implantant la même chose dans mon classeur , un message d'erreur apparaît et je ne comprend pas pourquoi...
Le voici :
Pièce jointe 214257
Cordialement,
29/06/2016, 13h05
casefayere

Je ne comprends pas, tu dois avoir fait une erreur, à ce stade, peux-tu envoyer un modèle simplifié avec les mêmes structures que ton fichier original ?
29/06/2016, 13h47
Patouillou

1 pièce(s) jointe(s)

Je ne comprend pas non plus ..
Le problème est toujours présent.. à noter que mon userform concerné est le 5 !
Voici le fichier : Pièce jointe 214260
Merci de ton aide !

j'ai vu le problème que je n'avais pas prévu, tu possèdes d'autres contrôles, donc, changes cette procédure dans le module de classe

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
Option Explicit
 
Public WithEvents groupeCheckBox As MSForms.CheckBox
 
Private Sub groupeCheckBox_Click()
  Nb = 0
  For Each Ctrl In UserForm5.Controls
    If TypeOf Ctrl Is MSForms.CheckBox Then
      If Ctrl = True Then
        Nb = Nb + 1
        If Nb > 10 Then MsgBox "Limité à 10": UserForm5.ActiveControl = False
      End If
    End If
  Next
End Sub

j'ai également amélioré les codes pour être sur que le groupe s'alimente bien (pas obligatoire)
dans le module standart, ajoutes cette procédure

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
Sub ini()
  Set Collect = New Collection
  With UserForm5
    For Each Ctrl In .Controls
      'verifie s'il s'agit d'un CheckBox
      If TypeOf Ctrl Is MSForms.CheckBox Then
        Set Cl = New C_CheckBox
        Set Cl.groupeCheckBox = Ctrl
        Collect.Add Cl
      End If
    Next Ctrl
  End With
 
End Sub

et le code de l'Usf (Initialize) devient

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
Private Sub UserForm_initialize()
Dim Cl         As C_CheckBox
  ini
  TextBox1 = "Purge des pompes "
  TextBox13 = "Contrôles électriques (tension et protection)"
  TextBox3 = "Essai de la sécurité manque d'eau"
  TextBox4 = "Démarrage automatique et arrêt sur débit nul"
  TextBox5 = "Permutation des pompes"
  TextBox6 = "Etalonnage du vase"
  TextBox7 = "Vérification compresseur"
  TextBox8 = "Vérification vanne de décharge"
  TextBox9 = "Vérification remplissage= "
  TextBox10 = "Contrôle volume utile de la fosse de relevage"
  TextBox11 = "Installation de la sécurité manque d’eau"
  TextBox12 = "Vérification de la pression aux points de puisage"
  TextBox2 = " Purge pompe"
  TextBox14 = "Contrôle sens de rotation des pompes"
  TextBox15 = "Alignement réalisé"
  TextBox16 = "Valiation du point de fonctionnement"
End Sub

tu ajoutes dans "Activate"

Code:

1
2
3
Private Sub UserForm_Activate()
ini
End Sub

29/06/2016, 14h15
Patouillou

Yes !! Ça marche !
Merci beaucoup de m'avoir aidé et pris du temps pour mon problème !

Codrialement,
Patouillou
29/06/2016, 14h23
casefayere

je t'améliore encore quelques points, et si tu es satisfait, penses aux contributeurs en bas des messages :plusser:

je te tiens au courant

ta procédure "Initialize" peut devenir

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
Private Sub UserForm_initialize()
Dim LaListe, x As Integer
ini
LaListe = Array("Purge des pompes ", " Purge pompe", "Essai de la sécurité manque d'eau", "Démarrage automatique et arrêt sur débit nul", _
  "Permutation des pompes", "Etalonnage du vase", "Vérification compresseur", "Vérification vanne de décharge", _
  "Vérification remplissage= ", "Contrôle volume utile de la fosse de relevage", "Installation de la sécurité manque d’eau", _
  "Vérification de la pression aux points de puisage", "Contrôles électriques (tension et protection)", "Contrôle sens de rotation des pompes", _
  "Alignement réalisé", "Valiation du point de fonctionnement")
 
  For x = 1 To 16
      Me.Controls("TextBox" & x) = LaListe(x - 1)
  Next x
End Sub

j'ai mal placé cette déclaration, remets-là dans le module standart

Code:

Dim Cl As C_CheckBox

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
Sub ini()
Dim Cl As C_CheckBox
  Set Collect = New Collection
  With UserForm5
    For Each Ctrl In .Controls
      'verifie s'il s'agit d'un CheckBox
      If TypeOf Ctrl Is MSForms.CheckBox Then
        Set Cl = New C_CheckBox
        Set Cl.groupeCheckBox = Ctrl
        Collect.Add Cl
      End If
    Next Ctrl
  End With
 
End Sub