Bonjour,

Comment faire pour trier cette listbox par ordre alphabétique ?

Merci pour votre aide
Meilleures salutations
Philippe

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
Option Explicit
Dim f, choix(), Rng, Ncol
Dim n As Variant
Dim k As Variant
Private Sub UserForm_Initialize()
Dim DerniereLigne As Long
Dim c As Variant
Dim tmp As Variant
Dim TblTmp()
On Error GoTo FichierVide
    Set f = ActiveSheet
    If ActiveSheet.FilterMode = True Then ActiveSheet.ShowAllData 'Enlever les filtres
    DerniereLigne = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
    Set Rng = Range(Cells(25, 1), Cells(DerniereLigne, 1))
    n = 0
    For Each c In Rng.SpecialCells(xlCellTypeConstants, 23)
        n = n + 1
        ReDim Preserve TblTmp(1 To 2, 1 To n)
        TblTmp(1, n) = c.Address
        On Error Resume Next
        tmp = Replace(Replace(c.Value, Chr(13), "  -  "), Chr(10), "")
        tmp = c.Value
        On Error GoTo 0
        TblTmp(2, n) = tmp
        ReDim Preserve choix(1 To n)
        choix(n) = choix(n) & TblTmp(1, n) & " * " & TblTmp(2, n)
    Next c
    Ncol = 2
    Me.ListBox1.List = Application.Transpose(TblTmp)
    Me.TextBox1.SetFocus 'Place le curseur dans la textbox
    Me.Label_Nombre_trouve.Caption = "Trouvé : " & n + 1
FichierVide:
End Sub
Private Sub TextBox1_Change()
Dim Mots As Variant
Dim Tbl As Variant
Dim i As Variant
Dim a As Variant
   On Error Resume Next 'Evite le beug lorsque l'on saisi un espace pour commencer
   If Me.TextBox1 <> "" Then
        Mots = Split(Trim(Me.TextBox1), " ")
        Tbl = choix
        For i = LBound(Mots) To UBound(Mots)
            Tbl = Filter(Tbl, Mots(i), True, vbTextCompare)
        Next i
        If UBound(Tbl) > -1 Then
                n = 0: Dim b()
            For i = LBound(Tbl) To UBound(Tbl)
                a = Split(Tbl(i), "*")
                n = n + 1: ReDim Preserve b(1 To Ncol, 1 To n)
                For k = 1 To Ncol
                    b(k, i + 1) = a(k - 1)
                Next k
            Next i
            If n > 0 Then
                ReDim Preserve b(1 To Ncol, 1 To n + 1)
                Me.ListBox1.List = Application.Transpose(b)
                Me.ListBox1.RemoveItem n
            End If
        Else
            Me.ListBox1.Clear
        End If
        Me.Label_Nombre_trouve.Caption = "Trouvé : " & UBound(Tbl) + 1
    Else
        UserForm_Initialize
    End If
End Sub
Private Sub ListBox1_Click()
Dim Filtre_Val_Cellule_Active As Variant
Dim adr As Variant
Dim Ligne As Long
    For k = 0 To Ncol - 1
      Me("TextBox" & k + 2) = Me.ListBox1.Column(k)
    Next k
    adr = Me.ListBox1
    Ligne = Range(adr).Row 'Numéro de la ligne
    Rows(Ligne).Select 'Déplace le document pour rendre visible l'étiquette
    'N° Projet_eta - filtre la valeur de la cellule active
    Filtre_Val_Cellule_Active = Cells(Ligne, 3).Value
    ActiveSheet.Range("A25").AutoFilter Field:=3, Criteria1:="=" & Filtre_Val_Cellule_Active
    ActiveWindow.ScrollRow = 1 'Deplace le focus de l'écran sur la ligne 1
End Sub
Private Sub CommandButton1_Click()
Unload Me
End Sub