Listbox en cascade et sélections multiples

Version imprimable

23/06/2015, 10h43
Sofy16

1 pièce(s) jointe(s)

Listbox en cascade et sélections multiples

Bonjour à tous,

Je vous explique où j'en suis :
J'ai 2 régions, chaque région contient 2 ou 3 pays puis chaque pays contient 2 à 3 sites.
J'ai besoin de sélectionner des sites, mais j'aimerais également pouvoir sélectionner l'ensemble des sites d'un pays, ou une région complète en cliquant uniquement sur le pays/la région.
J'ai donc mes trois listbox : région - pays - site
Et une textbox en dessous

J'aimerais que dans la textbox s'affiche l'ensemble des sites lorsque je clique sur la région. Si ensuite je clique sur le pays, seuls les sites du pays s'affichent, etc. Je pense qu'il me faudrait un bouton "add" pour ensuite les ajouter sur ma feuille excel.

C'est surtout pour la "sélection en cascade" que j'ai besoin d'aide, ainsi que l'apparition de la sélection dans la textbox.

Ci-joint, mon premier fichier.

Merci beaucoup et bonne journée

Pièce jointe 181293
23/06/2015, 11h46
eric4459

Bonjour Sofy,
Peux-tu confirmer que seul le tableau des plages A4 à C15 est utile?
Eric
23/06/2015, 12h05
Sofy16

Bonjour Eric,

Oui en effet, seul ce tableau est utile.
En fait celui du dessous est le même, mais en version "liste". Je ne sais pas encore si je vais utiliser l'un ou l'autre format, ou les deux.

Merci
23/06/2015, 14h06
eric4459

Sofy 16,
C'est assez complexe en fait, enfin pour mon niveau, vois-tu un inconvénient si j'utilises plusieurs Userform qui apparaîtront au fur et à mesure que l'on sélectionne les données?
Par exemple si tu choisi le pays en appuyant sur un bouton d'un premier UserForm, un second Userform apparaîtra avec la liste des site associés, si tu choisi la région un UserForm avec les pays apparaîtra etc...
Eric
23/06/2015, 15h13
Sofy16

Cela ne me pose aucun problème ! Ce sera déjà un très bon début !
Mais le seul inconvénient que j'y vois c'est est-ce qu'il sera alors possible, en sélectionnant une région, d'obtenir tous les sites correspondant ?

Merci beaucoup Eric :)
23/06/2015, 15h23
eric4459

Sofy,
Je vais coder pour que toutes les options soient prises en compte.
Si j'ai bien compris, tu voudrais que la sélection apparaisse dans un TextBox sur un UserForm et sur la page "Selection", c'est bien cela?
Eric
23/06/2015, 15h34
Sofy16

Oui ça serait super, après une fois apparu dans le textbox, je n'aurais pas de mal à le faire apparaitre sur ma feuille excel (ça je sais faire :) )

2 pièce(s) jointe(s)

Bonsoir Sofy,
Voici un premier jet, j'ai uniquement codé pour le choix du pays pour l'instant.
Si entre temps tu as des remarques concernant le résultat de ce premier jet, n'hésites pas à m'en faire part.

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
Option Explicit
 
Sub Selection_Pays()
Dim Data As Worksheet
Dim SLC As Worksheet
Dim i As Integer
Dim j As Integer
Dim k As Integer
Dim Nbligne As Integer
Dim Nbligne1 As Integer
Dim Nbligne2 As Integer
Dim CHX As Range
Dim Reg As Range
Dim Pays As Range
Dim Site As Range
Dim Sel1 As Range
Dim Sel2 As Range
Dim Sel3 As Range
Dim Resultat As Range
Set Data = ThisWorkbook.Sheets("Data")
Set SLC = ThisWorkbook.Sheets("Selection")
Set CHX = Data.Range("A5")
Set Reg = Data.Range("E5")
Set Pays = Data.Range("F5")
Set Site = Data.Range("G5")
Set Sel1 = Data.Range("A1")
Set Sel2 = Data.Range("B1")
Set Sel3 = Data.Range("C1")
Set Resultat = SLC.Range("B2")
CHX = CHX.Offset(0)
Reg = Reg.Offset(0)
Pays = Pays.Offset(0)
Site = Site.Offset(0)
 
i = 0
 
Sel1.ClearContents
Sel2.ClearContents
Sel3.ClearContents
 
With Sheets("Data")
    Nbligne1 = .Cells(.Rows.Count, 1).End(xlUp).Row - 4 ' On compte le nombre de lignes du 1er tableau
    Nbligne2 = .Cells(.Rows.Count, 6).End(xlUp).Row - 4 ' On compte le nombre de lignes de la 2ème colonne du deuxième tableau
End With
 
Sélection_Pays.ComboBox1.List = Data.Range("F5" & ":" & "F" & (5 + Nbligne2)).Value
 
Sélection_Pays.Show
 
For i = 0 To Nbligne2
    If Sélection_Pays.ComboBox1 = Pays.Offset(i, 0) Then
        For j = 0 To Nbligne1
            If Pays.Offset(i, 0) = CHX.Offset(j, 1) Then
                Sel1 = CHX.Offset(j, 0)
                Sel2 = CHX.Offset(j, 1)
                If Sel3 = "" Then
                    Sel3 = CHX.Offset(j, 2)
                    Else
                    Sel3 = Sel3.Text & " et " & CHX.Offset(j, 2)
                End If
                Sélection.TextBox1 = "Région : " & Sel1 & vbCrLf & "Pays : " & Sel2 & vbCrLf & "Site(s) associé(s) : " & Sel3
            End If
        Next j
    End If
 
Next i
 
 
With Sheets("Selection")
    Nbligne = .Cells(.Rows.Count, 2).End(xlUp).Row  ' On compte le nombre de lignes du tableau feuille Selection
End With
 
For k = 0 To Nbligne
If Resultat.Offset(k, 0) = "" Then
Resultat.Offset(k, 0) = Sel1
Resultat.Offset(k, 1) = Sel2
Resultat.Offset(k, 2) = Sel3
Exit For
End If
Next k
 
Sélection.Show
 
End Sub

Pièce jointe 181368

Voici le code finalisé, j'espère qu'il répond à tes souhaits

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
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
Option Explicit
 
Sub Selection_Pays()
Dim Data As Worksheet
Dim SLC As Worksheet
Dim i As Integer
Dim j As Integer
Dim k As Integer
Dim Nbligne As Integer
Dim Nbligne1 As Integer
Dim Nbligne2 As Integer
Dim CHX As Range
Dim Reg As Range
Dim Pays As Range
Dim Site As Range
Dim Sel1 As Range
Dim Sel2 As Range
Dim Sel3 As Range
Dim Resultat As Range
Set Data = ThisWorkbook.Sheets("Data")
Set SLC = ThisWorkbook.Sheets("Selection")
Set CHX = Data.Range("A5")
Set Reg = Data.Range("E5")
Set Pays = Data.Range("F5")
Set Site = Data.Range("G5")
Set Sel1 = Data.Range("A1")
Set Sel2 = Data.Range("B1")
Set Sel3 = Data.Range("C1")
Set Resultat = SLC.Range("B2")
CHX = CHX.Offset(0)
Reg = Reg.Offset(0)
Pays = Pays.Offset(0)
Site = Site.Offset(0)
 
i = 0
 
Sel1.ClearContents 'on vide la cellule A1 qui sert de cellule tampon
Sel2.ClearContents 'on vide la cellule A2 qui sert de cellule tampon
Sel3.ClearContents 'on vide la cellule A3 qui sert de cellule tampon
 
With Sheets("Data")
    Nbligne1 = .Cells(.Rows.Count, 1).End(xlUp).Row - 4 ' On compte le nombre de lignes du 1er tableau
    Nbligne2 = .Cells(.Rows.Count, 6).End(xlUp).Row - 4 ' On compte le nombre de lignes de la 2ème colonne du deuxième tableau qui liste les pays
End With
 
Sélection_Pays.ComboBox1.List = Data.Range("F5" & ":" & "F" & (5 + Nbligne2)).Value ' on charge la la liste dans la ComboBox
Sélection_Pays.ComboBox1 = "" 'On vide la dernière valeur de la liste qui pourrait etre en mémoire
Sélection_Pays.Show
 
For i = 0 To Nbligne2 'On boucle sur la colonne des pays du 2ème tableau
    If Sélection_Pays.ComboBox1 = Pays.Offset(i, 0) Then 'Quand on trouve dans la colonne la valeur selectionnée dans la combobox
        For j = 0 To Nbligne1 ' on boucle sur le 1er tableau
            If Pays.Offset(i, 0) = CHX.Offset(j, 1) Then 'si dans le tableau on trouve la valeur selectionnée
                Sel1 = CHX.Offset(j, 0) 'on et en A1 la région correspondante
                Sel2 = CHX.Offset(j, 1) 'on et en A2 le pays correspondant
                If Sel3 = "" Then 'Si A3 est vide
                    Sel3 = CHX.Offset(j, 2) ' on y met le numéro du site associé
                    Else 'Si A3 n'est pas vide
                    Sel3 = Sel3.Text & " et " & CHX.Offset(j, 2) ' on y ajoute en A3 le dernier site associé trouvé
                End If
                Sélection.TextBox1 = "Région : " & Sel1 & vbCrLf & "Pays : " & Sel2 & vbCrLf & "Site(s) associé(s) : " & Sel3 ' on charge le texte qui sera dans la textbox
            End If
        Next j
    End If
 
Next i
 
 
With Sheets("Selection")
    Nbligne = .Cells(.Rows.Count, 2).End(xlUp).Row  ' On compte le nombre de lignes du tableau feuille Selection
End With
 
For k = 0 To Nbligne ' on boucle sur la colonne B de la feuille Selection
If Resultat.Offset(k, 0) = "" Then ' si la cellule est vide
Resultat.Offset(k, 0) = Sel1 ' on ajoute la région associée au pays selectionné
Resultat.Offset(k, 1) = Sel2 ' on ajoute le pays selectionné
Resultat.Offset(k, 2) = Sel3 ' on ajoute les sites associés
Exit For
End If
Next k
Sélection.Show ' on montre la TextBox
End Sub
 
Sub Selection_Région()
Dim Data As Worksheet
Dim SLC As Worksheet
Dim i As Integer
Dim j As Integer
Dim k As Integer
Dim Nbligne As Integer
Dim Nbligne1 As Integer
Dim Nbligne2 As Integer
Dim Nbligne3 As Integer
Dim CHX As Range
Dim Reg As Range
Dim Pays As Range
Dim Site As Range
Dim Sel1 As Range
Dim Sel2 As Range
Dim Sel3 As Range
Dim Resultat As Range
Dim SelPays As Range
Set Data = ThisWorkbook.Sheets("Data")
Set SLC = ThisWorkbook.Sheets("Selection")
Set CHX = Data.Range("A5")
Set Reg = Data.Range("E5")
Set Pays = Data.Range("F5")
Set Site = Data.Range("G5")
Set Sel1 = Data.Range("A1")
Set Sel2 = Data.Range("B1")
Set Sel3 = Data.Range("C1")
Set Resultat = SLC.Range("B2")
Set SelPays = Data.Range("I1")
CHX = CHX.Offset(0)
Reg = Reg.Offset(0)
Pays = Pays.Offset(0)
Site = Site.Offset(0)
SelPays = SelPays.Offset(0)
i = 0
 
Sel1.ClearContents 'on vide la cellule A1 qui sert de cellule tampon
Sel2.ClearContents 'on vide la cellule A2 qui sert de cellule tampon
Sel3.ClearContents 'on vide la cellule A3 qui sert de cellule tampon
Range(SelPays, SelPays.End(xlDown)).ClearContents 'on vide la colonne I qui sert de colonne tampon
 
With Sheets("Data")
    Nbligne1 = .Cells(.Rows.Count, 1).End(xlUp).Row - 4 ' On compte le nombre de lignes du 1er tableau
    Nbligne2 = .Cells(.Rows.Count, 5).End(xlUp).Row - 4 ' On compte le nombre de lignes de la 2ème colonne du deuxième tableau
    Nbligne3 = .Cells(.Rows.Count, 6).End(xlUp).Row - 4 ' On compte le nombre de lignes de la 2ème colonne du deuxième tableau
End With
 
 
Sélection_Région.ComboBox1.List = Data.Range("E5" & ":" & "E" & (5 + Nbligne2)).Value 'On charge la liste des la combobox des régions
Sélection_Région.ComboBox1 = "" 'On vide la dernière valeur de la liste qui pourrait etre en mémoire
Sélection_Région.Show ' on ouvre la fenetre qui permettra la selection de la région
 
For i = 0 To Nbligne2 - 1 ' on boucle sur la colonne du 2ème tableau qui contient les régions
    If Sélection_Région.ComboBox1 = Reg.Offset(i, 0) Then 'Quand on trouve dans la colonne la région selectionnée dans la combobox
 
            k = 0
 
          For j = 0 To Nbligne1 'On boucle sur la colonne du 1er tableau qui contient les régions
 
            If CHX.Offset(j, 0) = Reg.Offset(i, 0) And CHX.Offset(j, 1) <> CHX.Offset(j + 1, 1) Then ' Quand la région selectionnée est trouvée
            'et si le pays associé ets différent de la cellule du dessous ( en fait comme le nom de pays apparait plusieurs fois
            'on en selectionne qu'un seul
            SelPays.Offset(k, 0) = CHX.Offset(j, 1) 'on charge le colonne I avec le s noms des pays associés à la région choisie
            End If
 
            If SelPays.Offset(k, 0) = "" Then ' si la cellule est vide
            k = k ' on reste sur cette cellule
            Else
            k = k + 1 ' sinon on prend la cellule suivante
            End If
 
          Next j
 
 
 Sélection_Pays.ComboBox1.List = Data.Range(SelPays, SelPays.End(xlDown)).Value ' on charge la liste des pays trouvés
 Sélection_Pays.ComboBox1 = "" 'On vide la dernière valeur de la liste qui pourrait etre en mémoire
 Sélection_Pays.Show
 
        'Ici le code est identique à celui de la 1ère macro
 
            For j = 0 To Nbligne1
            If Reg.Offset(i, 0) = CHX.Offset(j, 0) Then
 
                If Sélection_Pays.ComboBox1 = CHX.Offset(j, 1) Then
                Sel1 = CHX.Offset(j, 0)
                Sel2 = CHX.Offset(j, 1)
                    If Sel3 = "" Then
                        Sel3 = CHX.Offset(j, 2)
                        Else
                        Sel3 = Sel3.Text & " et " & CHX.Offset(j, 2)
                    End If
                End If
                Sélection.TextBox1 = "Région : " & Sel1 & vbCrLf & "Pays : " & Sel2 & vbCrLf & "Site(s) associé(s) : " & Sel3
            End If
        Next j
    End If
 
Next i
 
 
With Sheets("Selection")
    Nbligne = .Cells(.Rows.Count, 2).End(xlUp).Row
End With
 
For k = 0 To Nbligne
If Resultat.Offset(k, 0) = "" Then
Resultat.Offset(k, 0) = Sel1
Resultat.Offset(k, 1) = Sel2
Resultat.Offset(k, 2) = Sel3
Exit For
End If
Next k
Sélection.Show
End Sub

Pièce jointe 181419

Eric

24/06/2015, 15h37
Sofy16

Bonjour Eric,
Je vais regarder tout ça cette après-midi
Merci beaucoup, cela va énormément m'aider !

2 pièce(s) jointe(s)

Bonjour,

je me permet une approche différente ?

1) 3 Plages nommées

- Liste sans doublon des régions
- Liste sans doublon des pays
- Matrice des Pays / régions / sites

2) un Formulaire permettant de sélectionner ses choix

Pièce jointe 181453

3) le résultat est extrait de manière brute sur une feuille à part

4) le code du userform

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
 
Private Sub CommandButton1_Click()
' AJOUTER SELECTION
    Dim TabRemove()
    With Me
        For i = 0 To 1
            ReDim TabRemove(0)
 
            For c = 1 To .Controls("ListBox" & 1 + i).ListCount
                If .Controls("ListBox" & 1 + i).Selected(c - 1) = True Then
                    .Controls("ListBox" & 3 + i).AddItem .Controls("ListBox" & 1 + i).List(c - 1)
                    ReDim Preserve TabRemove(UBound(TabRemove) + 1)
                    TabRemove(UBound(TabRemove)) = c - 1
                End If
            Next c
 
            For c = UBound(TabRemove) To LBound(TabRemove) + 1 Step -1
                .Controls("ListBox" & 1 + i).RemoveItem TabRemove(c)
            Next c
        Next i
    End With
End Sub
 
Private Sub CommandButton2_Click()
' VIDER SELECTION
    Dim TabRemove()
    With Me
        For i = 0 To 1
            ReDim TabRemove(0)
 
            For c = 1 To .Controls("ListBox" & 3 + i).ListCount
                If .Controls("ListBox" & 3 + i).Selected(c - 1) = True Then
                    .Controls("ListBox" & 1 + i).AddItem .Controls("ListBox" & 3 + i).List(c - 1)
                    ReDim Preserve TabRemove(UBound(TabRemove) + 1)
                    TabRemove(UBound(TabRemove)) = c - 1
                End If
            Next c
 
            For c = UBound(TabRemove) To LBound(TabRemove) + 1 Step -1
                .Controls("ListBox" & 3 + i).RemoveItem TabRemove(c)
            Next c
        Next i
    End With
End Sub
 
Private Sub CommandButton5_Click()
'TOUT AJOUTER
    With Me
        For i = 0 To 1
            For c = 1 To .Controls("ListBox" & 1 + i).ListCount
                .Controls("ListBox" & 3 + i).AddItem .Controls("ListBox" & 1 + i).List(c - 1)
            Next c
 
            For c = .Controls("ListBox" & 1 + i).ListCount To 1 Step -1
                .Controls("ListBox" & 1 + i).RemoveItem c - 1
            Next c
        Next i
    End With
End Sub
 
Private Sub CommandButton3_Click()
'TOUT VIDER
    With Me
        For i = 0 To 1
            For c = .Controls("ListBox" & 3 + i).ListCount To 1 Step -1
                .Controls("ListBox" & 1 + i).AddItem .Controls("ListBox" & 3 + i).List(c - 1)
            Next c
 
            For c = .Controls("ListBox" & 3 + i).ListCount To 1 Step -1
                .Controls("ListBox" & 3 + i).RemoveItem c - 1
            Next c
        Next i
    End With
End Sub
 
Private Sub CommandButton4_Click()
'EXTRAIRE
    Dim Tablo
    Dim Resultat()
    Tablo = Range("MATRICE")
 
    With Me
        If .ListBox3.ListCount = 0 Then
            MsgBox "Aucune Region Choisie"
            Exit Sub
        ElseIf .ListBox4.ListCount = 0 Then
            MsgBox "Aucun Pays Choisi"
            Exit Sub
        End If
 
        ReDim Resultat(0)
        Feuil4.Cells.ClearContents
        For i = 1 To .ListBox3.ListCount
            For j = 1 To .ListBox4.ListCount
                For c = LBound(Tablo) To UBound(Tablo)
                    If Tablo(c, 1) = .ListBox3.List(i - 1) And Tablo(c, 2) = .ListBox4.List(j - 1) Then
                        ReDim Preserve Resultat(UBound(Resultat) + 1)
                        Resultat(UBound(Resultat)) = Tablo(c, 1) & "||" & Tablo(c, 2) & "||" & Tablo(c, 3)
                    End If
                Next c
            Next j
        Next i
 
        Feuil4.Cells(1, 1).Resize(UBound(Resultat) + 1, 1).Value = Application.Transpose(Resultat)
        Feuil4.Activate
    End With
End Sub
 
Private Sub UserForm_Initialize()
Dim Tablo
 
    Tablo = Application.Transpose(Range("REGION"))
    Me.ListBox1.List = Tablo
    Tablo = Application.Transpose(Range("PAYS"))
    Me.ListBox2.List = Tablo
End Sub

J'ai réalisé ça assez rapidement, le code n'est donc pas optimisé à 100%
Reste, bien entendu, à adapter et faire les micros réglages selon tes souhaits

Eric :coucou:, j'ai bien lu ton mp lié à ce fil, c'est la raison de ma contribution :P

24/06/2015, 17h36
Sofy16

1 pièce(s) jointe(s)

Joe, Eric,

Encore une fois, merci à tous les deux pour votre contribution :)
Vous trouverez ci-dessous la forme pour laquelle j'ai finalement opté, mais votre aide m'a permis de mieux y réfléchir ! Je n'ai malheureusement pas le temps de travailler plus les userform (deadline du travail...), c'est pourquoi j'ai utilisé des listes et macro plus basiques. Mais vos travaux me servirons sûrement une autre fois !

En revanche, sur mon fichier, lorsque je veux ajouter les sites, Excel me recopie la mise en forme alors qu'il ne le fait pas pour les autres (cluster et country) ? 8O Si jamais vous avez une solution sans y passer plus de 2 minutes :)

Bonne fin de journée,

Pièce jointe 181458