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
|
Public Sub SortListView(ByVal Index As Integer, _
ByVal DataType As ListViewListDataType, Optional ByVal Ascending As Boolean = True, _
Optional ByVal InverseSort As Boolean = True)
' ********* FONCTIONS ******************************************************************
' -------------------------------------------------------------------------
' Trier une ListView pour un texte, une date ou un chiffre
' -------------------------------------------------------------------------
' Parameters:
'
' ListView :Référence a l'object ListView
' Index :Index of the column in the ListView to be sorted. The first
' column in a ListView has an index value of 1.
' DataType :Sets whether the data in the column is to be sorted
' alphabetically, numerically, or by date.
' Ascending :Sets the direction of the sort. True sorts A-Z (Ascending),
' and False sorts Z-A (descending)
' -------------------------------------------------------------------------
On Error GoTo SortListView_Error
On Error Resume Next
Dim i As Integer
Dim l As Long
Dim strFormat As String
' Bloque la Maj ecran
Call LocklistView
If InverseSort Then _
Ascending = IIf(olistView.SortOrder = lvwAscending, False, True)
Dim blnRestoreFromTag As Boolean
Select Case DataType
Case ldtString
' Sort alphabetically. This is the only sort provided by the
' MS ListView control (at this time), and as such we don't really
' need to do much here
blnRestoreFromTag = False
Case ldtNumber
' Sort Numerically
strFormat = String$(20, "0") & "." & String$(10, "0")
' Loop through the values in this column. Re-format the values so
' as they can be sorted alphabetically, having already stored their
' text values in the tag, along with the tag's original value
With olistView.ListItems
If (Index = 1) Then
For l = 1 To .count
With .Item(l)
.Tag = .Text & Chr$(0) & .Tag
If IsNumeric(.Text) Then
If CDbl(.Text) >= 0 Then
.Text = Format(CDbl(.Text), strFormat)
Else
.Text = "&" & InvNumber(Format(0 - CDbl(.Text), strFormat))
End If
Else
.Text = ""
End If
End With
Next l
Else
For l = 1 To .count
With .Item(l).ListSubItems(Index - 1)
.Tag = .Text & Chr$(0) & .Tag
If IsNumeric(.Text) Then
If CDbl(.Text) >= 0 Then
.Text = Format(CDbl(.Text), strFormat)
Else
.Text = "&" & InvNumber(Format(0 - CDbl(.Text), strFormat))
End If
Else
.Text = ""
End If
End With
Next l
End If
End With
blnRestoreFromTag = True
Case ldtDateTime
' Sort by date.
strFormat = "YYYYMMDDHhNnSs"
Dim dte As Date
' Loop through the values in this column. Re-format the dates so as they
' can be sorted alphabetically, having already stored their visible
' values in the tag, along with the tag's original value
With olistView.ListItems
If (Index = 1) Then
For l = 1 To .count
With .Item(l)
.Tag = .Text & Chr$(0) & .Tag
dte = CDate(.Text)
.Text = Format$(dte, strFormat)
End With
Next l
Else
For l = 1 To .count
With .Item(l).ListSubItems(Index - 1)
.Tag = .Text & Chr$(0) & .Tag
dte = CDate(.Text)
.Text = Format$(dte, strFormat)
End With
Next l
End If
End With
blnRestoreFromTag = True
End Select
' Sort the ListView Alphabetically
olistView.SortOrder = IIf(Ascending, lvwAscending, lvwDescending)
olistView.SortKey = Index - 1
olistView.Sorted = True
' Restore the Text Values if required
If blnRestoreFromTag Then
' Restore the previous values to the 'cells' in this column of the list
' from the tags, and also restore the tags to their original values
With olistView.ListItems
If (Index = 1) Then
For l = 1 To .count
With .Item(l)
i = InStr(.Tag, Chr$(0))
.Text = Left$(.Tag, i - 1)
.Tag = Mid$(.Tag, i + 1)
End With
Next l
Else
For l = 1 To .count
With .Item(l).ListSubItems(Index - 1)
i = InStr(.Tag, Chr$(0))
.Text = Left$(.Tag, i - 1)
.Tag = Mid$(.Tag, i + 1)
End With
Next l
End If
End With
End If
Call UnLocklistView
Exit Sub
SortListView_Error:
' Unlock the list window so that the OCX can update it
LockWindowUpdate 0&
Select Case Err.Number
Case Else
MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure SortListView of Module de classe Class_GestionListView"
End Select
End Sub
Private Sub LocklistView()
' Display the hourglass cursor whilst sorting
olistView.MousePointer = 11
' Prevent the ListView control from updating on screen - this is to hide
' the changes being made to the listitems, and also to speed up the sort
LockWindowUpdate olistView.HWnd
End Sub
Private Sub UnLocklistView()
' Unlock the list window so that the OCX can update it
LockWindowUpdate 0&
' Restore the previous cursor
olistView.MousePointer = lngCursor
End Sub |
Partager