Plusieurs CheckBox dans une ListBox

Version imprimable

Bonsoir, je bloque sur une question ou je n'arrive pas a trouver ma solution.
J'aimerais savoir si il y a possibilité que plusieurs CheckBox soit visible dans une ListBox ?
Exemple que si je clique sur les CheckBox A et B, l'ensemble des informations des cellules
("A5:C10") + ("A15:C19") Soit visible ?

c'est possible ?

Voici une partie de mon code que j'utilise
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 Private Sub CheckBoxA_Click() If CheckBoxA.Value = True Then 'Si coché ... Range("Q7").Value = "A" ListBox1.ColumnCount = 3 ListBox1.ColumnWidths = "30;170;30" ListBox1.RowSource = ("A5:C10") Else 'Si non coché ... Range("Q7").Value = "" ListBox1.RowSource = "" End If End Sub Private Sub CheckBoxB_Click() If CheckBoxB.Value = True Then 'Si coché ... Range("Q8").Value = "B" ListBox1.ColumnCount = 3 ListBox1.ColumnWidths = "30;170;30" ListBox1.RowSource = ("A15:C19") Else 'Si non coché ... Range("Q8").Value = "" ListBox1.RowSource = "" End If End Sub

04/08/2018, 09h14
eriiic

Bonjour,

il faudrait que tu boucles sur les checkbox pour alimenter ta listbox avec .additem
Il faut aussi que tu puisses retrouver les lignes concernées pour les supprimer si décochée.
Soit c'est faisable avec les 3 valeurs, soit il faut garder à jour un tableau.
eric

Bonjour,

Une piste :

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
 
Private Sub UserForm_Initialize()
 
    ListBox1.ColumnCount = 3
    ListBox1.ColumnWidths = "30;170;30"
 
End Sub
 
Private Sub CheckBoxA_Click()
 
    Remplir
 
End Sub
 
Private Sub CheckBoxB_Click()
 
    Remplir
 
End Sub
 
Sub Remplir()
 
    Dim Plage As Range
    Dim Tbl()
    Dim I As Long
    Dim J As Long
    Dim Cel As Range
 
    ListBox1.Clear
 
    If CheckBoxA.Value = True Then Set Plage = Range("A5:C10")
    If CheckBoxB.Value = True Then Set Plage = Range("A15:C19")
    If CheckBoxA.Value = True And CheckBoxB.Value = True Then Set Plage = Union(Range("A5:C10"), Range("A15:C19"))
 
    If Plage Is Nothing Then Exit Sub
 
    J = 1
 
    For Each Cel In Plage
 
        I = I + 1
        ReDim Preserve Tbl(1 To 3, 1 To J)
        Tbl(I, J) = Cel.Value
        If I = 3 Then I = 0: J = J + 1
 
    Next Cel
 
    ListBox1.List = Application.Transpose(Tbl)
 
End Sub

10/08/2018, 07h49
Pylox

Re

Bonjour,

un grand merci pour vos réponses. Theze, ton code marche très bien.
Merci pour votre rapidité de réponse

Bon week-end