按一下按钮排序列表框

Question

我需要一些帮助，在我的表单中排序列表框。

我有一个列表框（LstPlanung），列出了表中的所有条目。

HID  SID  DATUM   ZEIT 

AAA  AA   20.02.2017  15:00 
BBB  BB   16.02.2017  17:00 
...  ..   ..........  ..... 

是否有到列表框与“DATUM”按钮进行排序的机会吗？

Answer 1

列表框列仅为文本列表，因此即使列表框具有内置排序功能，也不适用于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 

Answer 2

你必须使用VBA来管理LstPlanung的RowSource。

在最简单的场景LstPlanung不已经有一个ORDER BY，你可以只使用：

Me.LstPlanung.RowSource=Me.LstPlanung.RowSource & " ORDER BY Datum" 
Me.LstPlanung.Requery 

如果已经有一个ORDER BY那么你将有可能通过复制粘贴来重新创建RowSource（代码中的现有代码，并用'Datum'代替ORDER BY部分中的任何内容）。