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
199
200
201
| Private Sub CommandButton1_Click()
Call effacer
End Sub
Private Sub Lb_Liste_Click()
On Error GoTo ErrorHandler
If Me.Lb_Liste.List(Me.Lb_Liste.ListIndex, 1) = "Code parc" Then
Me.TextBox1.value = ""
Else
Me.TextBox1.value = Me.Lb_Liste.List(Me.Lb_Liste.ListIndex, 1)
End If
Exit Sub
ErrorHandler:
MsgBox "Une erreur s'est produite dans la procédure Lb_Liste_Click : " & Err.Description
End Sub
Private Sub TextBox2_Change()
On Error GoTo ErrorHandler
Dim searchText As String
Dim ws As Worksheet
Dim listBoxItems As Variant
Dim i As Integer
' Réinitialiser la ListBox
Me.Lb_Liste.Clear
' Récupérer le texte recherché dans le TextBox
searchText = LCase(Trim(Me.TextBox2.value))
' Vérifier si le texte n'est pas vide
If Len(searchText) > 0 Then
' Boucler à travers les cellules de la colonne A de la feuille "Atal"
Set ws = ThisWorkbook.Sheets("Atal")
If ws Is Nothing Then
MsgBox "Feuille 'Atal' introuvable."
Exit Sub
End If
listBoxItems = ws.Range("A1:A" & ws.Cells(ws.Rows.Count, "A").End(xlUp).Row).value
For i = LBound(listBoxItems, 1) To UBound(listBoxItems, 1)
If InStr(1, LCase(listBoxItems(i, 1)), searchText) > 0 Then
' Ajouter l'élément correspondant à la ListBox
Me.Lb_Liste.AddItem listBoxItems(i, 1)
End If
Next i
Else
' Si le texte est vide, réinitialiser la ListBox avec toutes les données
UserForm_Activate ' Appelez la procédure UserForm_Activate pour réinitialiser la ListBox
End If
Exit Sub
ErrorHandler:
MsgBox "Une erreur s'est produite dans la procédure TextBox2_Change : " & Err.Description
End Sub
Private Sub UserForm_Activate()
Dim th As Worksheet
Dim n As Integer
Dim C As Integer
Set th = Sheets("Atal")
n = Application.WorksheetFunction.CountA(th.Range("A:A"))
C = Application.WorksheetFunction.CountA(th.Rows(1))
' Set the range for the ListBox RowSource
Set listRange = th.Range("A1:L" & n)
' Populate the ListBox on the UserForm
With Me.Lb_Liste ' Assuming Lb_Liste is the name of your ListBox on the UserForm
.ColumnHeads = False
.ColumnCount = C
.RowSource = listRange.Address
End With
Call AlimenteCombo
End Sub
Private Sub AlimenteCombo()
Dim ws As Worksheet
Dim cell As Range
Dim uniqueValues() As Variant
Dim value As Variant
Dim i As Long, j As Long, n As Long
' Référence à la feuille "Atal"
Set ws = ThisWorkbook.Sheets("Atal")
If ws Is Nothing Then
MsgBox "Feuille 'Atal' introuvable."
Exit Sub
End If
' Parcourir la colonne A pour récupérer les valeurs uniques
n = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
ReDim uniqueValues(1 To n)
j = 1
For Each cell In ws.Range("A1:A" & n)
value = cell.value
If Not IsError(value) And Not IsEmpty(value) Then
' Vérifier si la valeur existe déjà dans uniqueValues
For i = 1 To j - 1
If uniqueValues(i) = value Then Exit For
Next i
If i > j - 1 Then ' La valeur n'est pas encore dans uniqueValues
uniqueValues(j) = value
j = j + 1
End If
End If
Next cell
' Trier les valeurs uniques
If j > 1 Then
Call BubbleSort(uniqueValues, j - 1) ' Utiliser la méthode Bubble Sort (à définir)
End If
' Ajouter les valeurs triées à ComboBox1
Me.ComboBox1.Clear
For i = 1 To j - 1
Me.ComboBox1.AddItem uniqueValues(i)
Next i
End Sub
' Méthode Bubble Sort pour trier un tableau de valeurs
Private Sub BubbleSort(arr() As Variant, ByVal n As Long)
Dim i As Long, j As Long
Dim temp As Variant
For i = 1 To n - 1
For j = i + 1 To n
If arr(i) > arr(j) Then
temp = arr(i)
arr(i) = arr(j)
arr(j) = temp
End If
Next j
Next i
End Sub
'Me.Lb_Liste.RowSource = vbNullString
Private Sub effacer()
' Réinitialiser la ListBox
With Me.Lb_Liste
.ColumnHeads = False
.ColumnCount = 0
.RowSource = ""
End With
End Sub
Private Sub ComboBox1_Change()
Dim ws As Worksheet
Dim filterValue As Variant
Dim dataRange As Range
Dim cell As Range
Dim lastRow As Long
Dim rowIndex As Long
On Error GoTo ErrorHandler
' Récupérer la valeur sélectionnée dans la ComboBox
filterValue = Me.ComboBox1.value
' Référence à la feuille "Atal"
Set ws = ThisWorkbook.Sheets("Atal")
If ws Is Nothing Then
MsgBox "Feuille 'Atal' introuvable."
Exit Sub
End If
' Réinitialiser la ListBox
Call effacer
' Vérifier si une valeur est sélectionnée dans la ComboBox
If Len(filterValue) > 0 Then
' Déterminer la dernière ligne de données
lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
' Parcourir les données pour trouver les lignes correspondant au filtre
rowIndex = 0 ' Initialiser l'index de ligne
For Each cell In ws.Range("A2:A" & lastRow) ' Commencer à la deuxième ligne pour exclure les en-têtes
rowIndex = rowIndex + 1
If cell.value = filterValue Then
' Ajouter les valeurs de la ligne correspondante à la ListBox
For i = 1 To 11 ' Correspond aux colonnes A à K
Me.Lb_Liste.AddItem ws.Cells(rowIndex, i).value
Next i
End If
Next cell
Else
' Si aucune valeur sélectionnée, réinitialiser la ListBox avec toutes les données
UserForm_Activate ' Appelez la procédure UserForm_Activate pour réinitialiser la ListBox
End If
Exit Sub
ErrorHandler:
MsgBox "Une erreur s'est produite : " & Err.Description
End Sub |
Listbox et mise à jour en fonction du choix dans un combobox
Répondre avec citation
Partager