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
| Private Sub userform_initialize()
'codage des noms des champs dynamiques
ActiveWorkbook.Names.Add Name:="An", RefersTo:="=OFFSET(Cells(2,ColA),,,CountA((" & Columns(ColA).Address & ") - 1)"
ActiveWorkbook.Names.Add Name:="Collectivité", RefersTo:="=OFFSET(Cells(2,ColC),,,CountA(" & Columns(ColC).Address & ") - 1)"
ActiveWorkbook.Names.Add Name:="Domaine", RefersTo:="=OFFSET(Cells(2,ColD),,,CountA(" & Columns(ColD).Address & ") - 1)"
Ch_Nom
Ch_An
Ch_Domaine
On Error Resume Next
ActiveSheet.ShowAllData
End Sub
Private Sub Collectivité_DropButtonClick()
Ch_Nom
End Sub
Private Sub Domaine_DropButtonClick()
Ch_Domaine
End Sub
Private Sub An_DropButtonClick()
Ch_An
End Sub
Private Sub An_Change()
filtre
End Sub
Private Sub Domaine_Change()
filtre
End Sub
Private Sub Collectivité_Change()
filtre
End Sub
Sub Ch_Nom()
Set MonDico = CreateObject("Scripting.Dictionary")
For i = 1 To Range("Collectivité").Count
If Range("Domaine")(i) Like Me.Domaine And CStr(Range("An")(i)) Like Me.An Then
temp = Range("Collectivité")(i)
If Not MonDico.Exists(temp) Then
MonDico.Add temp, temp
End If
End If
Next i
MonDico.Add "*", "*"
temp = MonDico.items
Call Tri(temp, LBound(temp), UBound(temp))
Me.Collectivité.list = temp
End Sub
Sub Ch_An()
Set MonDico = CreateObject("Scripting.Dictionary")
For i = 1 To Range("An").Count
If Range("Collectivité")(i) Like Me.Collectivité And Range("Domaine")(i) Like Me.Domaine Then
temp = Range("An")(i)
If Not MonDico.Exists(temp) Then
MonDico.Add temp, temp
End If
End If
Next i
MonDico.Add "*", "*"
temp = MonDico.items
Call Tri(temp, LBound(temp), UBound(temp))
Me.An.list = temp
End Sub
Sub Ch_Domaine()
Set MonDico = CreateObject("Scripting.Dictionary")
For i = 1 To Range("Domaine").Count
If Range("Collectivité")(i) Like Me.Collectivité And CStr(Range("An")(i)) Like Me.An Then
temp = Range("Domaine")(i)
If Not MonDico.Exists(temp) Then
MonDico.Add temp, temp
End If
End If
Next i
MonDico.Add "*", "*"
temp = MonDico.items
Call Tri(temp, LBound(temp), UBound(temp))
Me.Domaine.list = temp
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
Sub filtre()
Dim Cellule
Cellule = Cells(1, ColP)
On Error Resume Next
ActiveSheet.ShowAllData
Cellule.AutoFilter Field:=1, Criteria1:=Me.Collectivité
If Me.An <> "*" Then Cellule.AutoFilter Field:=3, Criteria1:=Me.An
Cellule.AutoFilter Field:=2, Criteria1:=Me.Domaine
End Sub
Private Sub B_OK_Click()
CollectR = Me.Collectivité
DomR = Me.Domaine
AnR = Me.An
Call LigneRef
ActiveSheet.ShowAllData
Unload ChxRef
End Sub
Sub LigneRef()
Dim ligne As Integer
If Range("A:A").SpecialCells(xlCellTypeVisible).Areas(1).Count > 1 Then
ligne = 2 'pas de filtre
Else 'il y a un filtre
ligne = Range("A:A").SpecialCells(xlCellTypeVisible).Areas(2).Item(1).Row
End If
LgR = ligne
End Sub |
