我需要帮助我在表单中对列表框进行排序。
我有一个列表框（LstPlanung），列出了表格的所有条目。
HID SID DATUM ZEIT
AAA AA 20.02.2017 15:00
BBB BB 16.02.2017 17:00
... .. .......... .....
是否有可能使用“DATUM”按钮对列表框进行排序？
答案 0 :(得分：2)
列表框列只是文本，因此即使列表框具有内置排序，也不会使用dd.mm.yyyy个日期。
要按日期（或数字）正确排序，必须在RowSource属性中进行排序。
我建议使用John Spencer的以下代码，通过右键单击任意列进行排序 它非常有用，我在许多列表框中使用它。
来源：http://www.utteraccess.com/forum/index.php?showtopic=1953978
Public Sub sSortListBox(anyListbox As Control, Button As Integer, Shift As Integer, X As Single)
'Purpose: Sort list box by column when column is right-clicked
'Author: Copyright by John Spencer
'Version Date: 04-14-2004
'Limitations:
' No Horizontal scroll bar in listbox
' RowSource must be query
' Uses DAO code; not tested with ADP
'Permission to use in applications is granted to all
'with the understanding that credit is given to the author.
'No warrantee or guaranty is given - use at your own risk.
'
'Code to sort list in ascending/descending order
'depending on which column is right-clicked
'and whether shift key is pressed.
'Uses the SQL syntax of specifying a column number as the sort column -
' SELECT ... FROM ... ORDER BY N
'- where N is integer reflecting the position of a field in SELECT clause.
'Install call to this code in the Mouse Down event of a listbox.
'Example -
' sSortListBox Me.SomeListbox, Button, Shift, X
'---------------------------------------------------------------------
'---------------------------------------------------------------------
'In the listbox's Mouse Up event add code to cancel the Mouse up event.
' If Button = acRightButton Then DoCmd.CancelEvent
'That line will stop any popup menu from appearing.
'---------------------------------------------------------------------
'---------------------------------------------------------------------
Dim strSQL As String
Dim vGetWidths As Variant
Dim vArWidths() As Variant
Dim iColCount As Integer, iColNumber As Integer
Dim i As Integer
Dim iColWidthSum As Integer
Dim iUndefined As Integer
Dim iDefaultWidth As Integer
Dim strOrderBy As String
Dim xStr As Long
Const strListSeparator As String = ";" 'list Separator
On Error GoTo ERROR_sSortListBox
If Button <> acRightButton Then
'only sort based on right button being clicked
ElseIf anyListbox.RowSourceType <> "table/query" Then
'only sort listbox based on queries
MsgBox "List box must use a query as it's row source"
ElseIf Len(anyListbox.RowSource) = 0 Then
'Nothing there, so ignore the click
ElseIf Not (InStr(1, Trim(anyListbox.RowSource), "Select", vbTextCompare) = 1 _
Or InStr(1, Trim(anyListbox.RowSource), "Parameters", vbTextCompare) = 1) Then
'If rowsource does not start with SELECT or PARAMETERS then
'assume it is a table not a query
MsgBox "List box must use a query as its row source"
ElseIf anyListbox.columnCount > DBEngine(0)(0).CreateQueryDef("", anyListbox.RowSource).Fields.Count Then
'Column count must be correctly set, otherwise this routine
'could cause errors. Column count set less than actual field count
'will cause subscript errors. Column count set higher than actual
'field count can cause listbox to display nothing if "Extra" column
'is clicked.
MsgBox "List box column count does not match query field count!"
Else 'passed the error checks
With anyListbox
iColCount = .columnCount
ReDim vArWidths(iColCount - 1, 0 To 1)
'Parse the column widths into an array.
vGetWidths = Split(.ColumnWidths, strListSeparator, -1, vbTextCompare)
'Assign values to array that holds length and running sum of length
For i = 0 To UBound(vGetWidths)
iColWidthSum = iColWidthSum + Val(vGetWidths(i))
vArWidths(i, 1) = iColWidthSum
vArWidths(i, 0) = vGetWidths(i)
Next i
'Adjust any colwidths that are unspecified:
'The minimum is the larger of 1440
'or the remaining available width of the list box
'divided by number of columns with unspecified lengths.
For i = 0 To iColCount - 1
If Len(vArWidths(i, 0) & vbNullString) = 0 Then
iUndefined = iUndefined + 1
End If
Next i
If iUndefined <> 0 Then
iDefaultWidth = (.Width - iColWidthSum) / iUndefined
End If
If iDefaultWidth > 0 And iDefaultWidth < 1440 Then
MsgBox "Sorry! Can't process listboxes with horizontal scrollbars!"
Exit Sub 'Horizontal scroll bar present
Else
'recalculate widths and running sum of column widths
iColWidthSum = 0
For i = 0 To iColCount - 1
If Len(vArWidths(i, 0) & vbNullString) = 0 Then
vArWidths(i, 0) = iDefaultWidth
End If
iColWidthSum = iColWidthSum + Val(vArWidths(i, 0))
vArWidths(i, 1) = iColWidthSum
Next i
End If
'Set right edge of last column equal to width of listbox
vArWidths(iColCount - 1, 1) = .Width
'Determine which column was clicked
For i = 0 To iColCount - 1
If X <= vArWidths(i, 1) Then
iColNumber = i
Exit For
End If
Next i
iColNumber = iColNumber + 1 'adjust since i is 0 to n-1
'rebuild sql statement
If iColNumber > 0 And iColNumber <= iColCount Then
strSQL = Trim(.RowSource)
If right(strSQL, 1) = ";" Then strSQL = Left(strSQL, Len(strSQL) - 1)
xStr = InStr(1, strSQL, "Order by", vbTextCompare)
If xStr > 0 Then
strOrderBy = Trim(Mid(strSQL, xStr + Len("Order by")))
strSQL = Trim(Left(strSQL, xStr - 1))
End If
'Build the appropriate ORDER BY clause
If Shift = acShiftMask Then
'If shift key is down force sort to desc on selected column
strOrderBy = " Order By " & iColNumber & " Desc"
ElseIf Len(strOrderBy) = 0 Then
'If no prior sort then sort this column ascending
strOrderBy = " Order by " & iColNumber & " Asc"
ElseIf InStr(1, strOrderBy, iColNumber & " Asc", vbTextCompare) > 0 Then
'If already sorted asc on this column then sort descending
strOrderBy = " Order By " & iColNumber & " Desc"
ElseIf InStr(1, strOrderBy, iColNumber & " Desc", vbTextCompare) > 0 Then
'If already sorted desc on this column then sort Ascending
strOrderBy = " Order By " & iColNumber & " Asc"
Else
strOrderBy = " Order by " & iColNumber & " Asc"
End If
strSQL = strSQL & strOrderBy
Debug.Print strSQL
.RowSource = strSQL
End If 'Rebuild SQL if col number is in range 1 to number of columns
End With 'current list
End If 'Passed error checks
EXIT_sSortListBox:
Exit Sub
ERROR_sSortListBox:
Select Case Err.Number
Case 9 'Subscript out of range
MsgBox Err.Number & ": " & Err.Description & _
vbCrLf & vbCrLf & "Check column count property of list box.", vbInformation, "ERROR: sSortListBox"
Case Else 'unexpected error
MsgBox Err.Number & ": " & Err.Description, vbInformation, "ERROR: sSortListBox"
End Select
Resume EXIT_sSortListBox
End Sub
，格式为：
Private Sub myList_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
Call sSortListBox(Me.myList, Button, Shift, X)
End Sub
Private Sub myList_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = acRightButton Then DoCmd.CancelEvent
End Sub
答案 1 :(得分：1)
您必须使用VBA来管理RowSource的{{1}}。
在LstPlanung尚未拥有LstPlanung的最简单方案中，您可以使用：
ORDER BY如果它已经有Me.LstPlanung.RowSource=Me.LstPlanung.RowSource & " ORDER BY Datum"
Me.LstPlanung.Requery
，则您必须重新创建ORDER BY（可能通过复制粘贴代码中的现有代码并替换RowSource部分中的任何内容'Datum'）。