Сортировка списка с нажатием кнопки

Question

Мне нужна помощь при сортировке списка в моей форме.

У меня есть список (LstPlanung), в котором перечислены все записи таблицы.

HID  SID  DATUM   ZEIT 

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

Есть ли шанс, чтобы отсортировать список с кнопкой по «DATUM»?

Answer 1

Столбец Listbox является текстовым, поэтому даже если в списке будет встроенная сортировка, он не будет работать с датами dd.mm.yyyy.

Для правильной сортировки по дате (или цифрам) сортировка должна осуществляться в RowSource.

Предлагаю использовать следующий код Джона Спенсера для сортировки по любому столбцу с помощью щелчка правой кнопкой мыши.
Это супер-полезно, и я использую его во многих списках.

Источник: 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 для управления RowSource из LstPlanung.

В простейшем случае, когда LstPlanung уже не имеют ORDER BY, вы могли бы просто использовать:

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

Если уже есть ORDER BY то вам придется заново создать RowSource (вероятно, копия пасты существующий в вашем коде и заменяющий все, что находится в части ORDER BY с «Datum»).