Userform avec Combobox en Cascade
Bonjour à tous,
J'ai reconstitué une macro que j'avais trouvé sur le site de J. Boisgontier, mais une partie du code m'échappe !
Celle-ci fait apparaître un userform permettant de récupérer des données en fonction de critères cumulatifs (via des combobx en cascade).
Est-ce possible de transposer ces combobox en listbox afin de faire des sélections multiples ?
Aussi, est-ce possible de ne faire afficher dans la listbox (où apparaissent les résultats) que les colonnes allant de H à L ?
Voici le 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
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
| Dim f, bd
Private Sub ListBox1_Click()
End Sub
Private Sub UserForm_Initialize()
Set f = Sheets("bd")
Set bd = f.Range("a2:L" & f.[A65000].End(xlUp).Row)
For c = 1 To 12
ListeCol c
Next c
filtre
For i = 1 To 12: Me("label" & i) = f.Cells(1, i): Next i
End Sub
Sub ListeCol(noCol)
Set MonDico = CreateObject("Scripting.Dictionary")
For i = 1 To bd.Rows.Count
ok = True
For n = 1 To bd.Columns.Count
If n <> noCol Then
If Not bd.Cells(i, n) Like Me("comboBox" & n) Then ok = False
End If
Next n
If ok Then
tmp = bd.Cells(i, noCol)
MonDico(tmp) = tmp
End If
Next i
MonDico.Add "*", "*"
temp = MonDico.items
Call Tri(temp, LBound(temp), UBound(temp))
Me("ComboBox" & noCol).List = temp
End Sub
Sub filtre()
Dim a()
ligne = 0
For i = 1 To bd.Rows.Count
ok = True
For n = 1 To bd.Columns.Count
If Not bd.Cells(i, n) Like Me("comboBox" & n) Then ok = False
Next n
If ok Then
ligne = ligne + 1
ReDim Preserve a(1 To 13, 1 To ligne)
For k = 1 To bd.Columns.Count: a(k, ligne) = bd.Cells(i, k): Next k
End If
Next i
If ligne = 1 Then ReDim Preserve a(1 To 13, 1 To 2)
Me.ListBox1.List = Application.Transpose(a())
Me.TextBox1 = ligne
End Sub
Private Sub CommandButton1_Click()
Sheets("result").[A2:M1000].Clear
Sheets("result").[A2].Resize(Me.ListBox1.ListCount, 12) = Me.ListBox1.List
End Sub
Sub Tri(a, gauc, droi) ' Quick sort
ref = CStr(a((gauc + droi) \ 2))
g = gauc: d = droi
Do
Do While CStr(a(g)) < ref: g = g + 1: Loop
Do While ref < CStr(a(d)): d = d - 1: Loop
If g <= d Then
temp = a(g): a(g) = a(d): a(d) = temp
g = g + 1: d = d - 1
End If
Loop While g <= d
If g < droi Then Call Tri(a, g, droi)
If gauc < d Then Call Tri(a, gauc, d)
End Sub
Private Sub ComboBox1_DropButtonClick()
ListeCol 1
End Sub
Private Sub ComboBox2_DropButtonClick()
ListeCol 2
End Sub
Private Sub ComboBox3_DropButtonClick()
ListeCol 3
End Sub
Private Sub ComboBox4_DropButtonClick()
ListeCol 4
End Sub
Private Sub ComboBox5_DropButtonClick()
ListeCol 5
End Sub
Private Sub ComboBox6_DropButtonClick()
ListeCol 6
End Sub
Private Sub ComboBox7_DropButtonClick()
ListeCol 7
End Sub
Private Sub ComboBox8_DropButtonClick()
ListeCol 8
End Sub
Private Sub ComboBox9_DropButtonClick()
ListeCol 9
End Sub
Private Sub ComboBox10_DropButtonClick()
ListeCol 10
End Sub
Private Sub ComboBox11_DropButtonClick()
ListeCol 11
End Sub
Private Sub ComboBox12_DropButtonClick()
ListeCol 12
End Sub
Private Sub ComboBox1_Change()
filtre
End Sub
Private Sub ComboBox2_Change()
filtre
End Sub
Private Sub ComboBox3_Change()
filtre
End Sub
Private Sub ComboBox4_Change()
filtre
End Sub
Private Sub ComboBox5_Change()
filtre
End Sub
Private Sub ComboBox6_Change()
filtre
End Sub
Private Sub ComboBox7_Change()
filtre
End Sub
Private Sub ComboBox8_Change()
filtre
End Sub
Private Sub ComboBox9_Change()
filtre
End Sub
Private Sub ComboBox10_Change()
filtre
End Sub
Private Sub ComboBox11_Change()
filtre
End Sub
Private Sub ComboBox12_Change()
filtre
End Sub |
Un grand merci à celles et ceux qui prendront le temps de me venir en aide :)
arochab
