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
| Option Explicit
'Variables globales à l'userform
Dim Tb
Dim Dm As Long
'========================================================
'Routine de remplissage de ListBox1 en fonction de:
' - n étant le nombre d'éléments à ajouter
' - S étant les données à ajouter
'En fonction du nombre d'éléments, on utilise soit .Additem (pour un unique élément) ou .List (pour un tableau)
Private Sub Remplissage(ByVal n As Long, ByVal S As Variant)
With Me.ListBox1
If n = 1 Then
.AddItem IIf(IsArray(S), S(1), S)
ElseIf n > 1 Then
.List = S
End If
End With
End Sub
'========================================================
Private Sub UserForm_Initialize()
Dim Fichier As String
Dim Wbk As Workbook
Dim LastLig As Long
Application.ScreenUpdating = False
'Nom complet du fichier NocoMaterBAse (à adapter)
Fichier = "C:\Users\user\Desktop\NovoMaterBAse.xls"
'Si le fichier existe
If Dir(Fichier) <> "" Then
'On ouvre le fichier
Set Wbk = Workbooks.Open(Fichier)
With Wbk.Worksheets("BAseListe")
'Dernière ligne remplie de la colonne B de la feuille BAseListe (!Il fallait aussi tester l'existence de cette feuille)
LastLig = .Cells(.Rows.Count, "B").End(xlUp).Row
'On affecte la plage utile à la variable globale Tb
Tb = .Range("B3:B" & LastLig)
'Dm contient le nombre d'éléments de la liste
Dm = LastLig - 2
End With
'On ferme le fichier sans sauvegarder
Wbk.Close False
Set Wbk = Nothing
'On appelle la routine de remplissage de Listbox1
Call Remplissage(Dm, Tb)
End If
End Sub
'========================================================
Private Sub TextBox1_Change()
Dim i As Long, j As Long
Dim Fltre As String
Dim Res() As String
'S'il y a au moins un élément dans notre liste
If Dm >= 1 Then
'Ici c'est le texte entré dans la TextBox1 (mis en amjuscule)
Fltre = UCase(Trim(Me.TextBox1))
With Me.ListBox1
'on efface note ListBox1
.Clear
'Si TextBox1<>""
If Fltre <> "" Then
'On parcourt le tableau Tb et on remplit le tableau Res par les émélents commençant par le texte entré en TextBox1
For i = 1 To UBound(Tb, 1)
If UCase(Tb(i, 1)) Like Fltre & "*" Then
j = j + 1
ReDim Preserve Res(1 To j)
Res(j) = Tb(i, 1)
End If
Next i
'à la fin, on appelle la routine de remplissage sur Res (les données filtrées par TextBox1)
Call Remplissage(j, Res)
'on efface Res
Erase Res
Else
'Si TextBox1 est vide, on appelle la routine de remplissage sur Tb (toutes les données)
Call Remplissage(Dm, Tb)
End If
End With
End If
End Sub
'========================================================
'à la femeture de l'usf, on efface Tb
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
Erase Tb
End Sub |
Partager