Dim Titres() As Single
Private Sub UserForm_Initialize()
Dim S As Worksheet
Dim R As Range
Dim var
Dim i&
Dim A$
Dim nbCol&
Dim Largeur!
Set S = Sheets(FEUILLE_DONNEES)
Set R = S.[a1].CurrentRegion
var = R
nbCol& = R.Columns.Count
ReDim Titres(1 To nbCol&)
For i& = 1 To nbCol&
Titres(i&) = R.Columns(i&).Width
Largeur! = Largeur! + Titres(i&)
A$ = A$ & Titres(i&) & ";"
Next i&
With ListBox1
.ColumnCount = nbCol&
.List = var
.ColumnWidths = Mid(A$, 1, Len(A$) - 1)
.Left = 5
.Top = 5
.Width = Largeur! + .Left
.Height = 500
DoEvents
Me.Width = Largeur! + (3 * .Left)
Me.Height = .Height + (4 * .Top)
Me.Caption = "Pour trier, cliquez droit sur un titre de colonne tout en maintenant Majuscule"
End With
End Sub
Private Sub ListBox1_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
Dim i&
Dim Largeur!
Dim S As Worksheet
Dim R As Range
Dim var
If Button = 2 And Shift = 1 And Y < 8 Then
On Error GoTo Erreur
For i& = 1 To UBound(Titres)
Largeur! = Largeur! + Titres(i&)
If X < Largeur! Then
With Application
.ScreenUpdating = False
.DisplayAlerts = False
End With
Sheets(FEUILLE_DONNEES).Copy before:=Sheets(1)
Set S = Sheets(1)
Set R = S.[a1].CurrentRegion
R.Sort key1:=R.Cells(1, i&), order1:=xlAscending, Header:=xlYes
var = R
ListBox1.List = var
S.Delete
Set S = Nothing
Exit For
End If
Next i&
End If
Erreur:
If Not S Is Nothing Then S.Delete
With Application
.ScreenUpdating = True
.DisplayAlerts = True
End With
End Sub
