Discussion :

[familledacp]

Re bonjour à tous et toutes

Mon projet avance bien, je suis à la recherche désormais d'une petite amélioration

J'ai un UserForm qui affiche 1300 lignes issues d'un fichier excel par le biais d'une ListBox

Voici le code de ce UserForm

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
Private Sub UserForm_Initialize()
     Workbooks.Open "e:\1-AFF\AAA\00Base\BaseMateriels\NovoMaterBAse.xls"
    ActiveWindow.WindowState = xlMinimized
    ListBox1.RowSource = "[NovoMaterBAse.xls]BAseListe!B3:B1300"
End Sub

Naviguer dans cette listbox n'est pas chose aisée, vu sa longueur

D'ailleurs, la roulette de la souris n'a pas d'effet sur le défilement

J'ai une TextBox dans ce UserForm

Je souhaite pouvoir modifier l'affichage dans la listBox en fonction de ce qui est saisi dans la TextBox

Par exemple, je saisis "M", l'affichage de la liste box se positionne sur "machine", si je tape "mo" cela passe à "moteur" ....

Avez vous une piste ?

De nouveau merci par avance pour votre aide

Daniel

[Jean-Pierre49]

dans les listbox tu à cette possibilité

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

ListBox1.MatchEntry = fmMatchEntryFirstLetter

[familledacp]

Bonsoir

Merci Jean Pierre pour cette nouvelle réponse pertinente

Si néanmoins tu as la méthode pour aller plus loin que la simple première lettre (caler la liste box selon les premières lettres ) je suis preneur

Bonsoir

Daniel

[Jean-Pierre49]

Je n'ai pas Excel sur ce PCet oui ça peut arriver

mais regarde pour la propriété MatchEntry il y a peu être mieux

Ton idée m'intéresse, mais ce Week end, c'est raper

J'espere pour toi que tu auras une solution avant

si non je vais m'y attacher
bon WN

[mercatog]

Bonjour
Une proposition pour filtrer une ListBox en fonction du contenu d'un TextBox

Code commenté à mettre dans le module de l'userform

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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

[familledacp]

Bonjour Mercatog et merci pour ce long post

Cela fonctionne parfaitement !

Merci de votre aide

Daniel