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
| Function SetList(this As ComboBox, ParamArray params() As Variant)
Dim oCollection As New Collection, stmps As String
Dim J, sRow, zt, tp, paramid, b, Refs As Long, elements, elem As Variant
Dim setfind As Boolean
sRow = Feuil5.Range("a" & Rows.Count).End(xlUp).Row
Refs = 100
setfind = True
paramid = UBound(params)
ReDim Tableau(Refs)
For b = 1 To sRow Step Refs
Tableau = Feuil5.Range("A1:L" & Refs).Offset(b, 0).Value
For zt = 1 To Refs
setfind = True
For tp = 1 To paramid
If (params(tp) <> Trim(Tableau(zt, tp))) Then
setfind = False
Exit For
End If
Next
If setfind Then
stmps = Trim(Tableau(zt, paramid + 1))
If stmps <> "" Then
On Error Resume Next
oCollection.Add stmps, CStr(stmps)
Err.Clear
End If
End If
Next
Next
If oCollection.Count > 0 Then
ReDim ss(oCollection.Count - 1, 0): J = 0
For Each elem In oCollection
ss(J, 0) = elem: J = J + 1
Next: this.List = ss
End If
SetList = oCollection.Count
End Function
Private Sub UserForm_Initialize()
Dim i As Long
i = SetList(Cmbo_1, "")
End Sub
Private Sub Cmbo_1_Change()
Dim i As Long
Cmbo_2.Clear
i = SetList(Cmbo_2, "", Cmbo_1.Value)
Cmbo_2_Change
End Sub
Private Sub Cmbo_2_Change()
Dim i As Long
Cmbo_3.Clear
i = SetList(Cmbo_3, "", Cmbo_1.Value, Cmbo_2.Value)
If i > 1 Then
Cmbo_3.AddItem ("Tous")
End If
End Sub
Private Sub Cmbo_3_Change()
Dim i As Long
Cmbo_4.Clear
i = SetList(Cmbo_4, "", Cmbo_1.Value, Cmbo_2.Value, Cmbo_3.Value)
If i > 1 Then
Cmbo_4.AddItem ("Tous")
End If
End Sub |
