hi，大家好！
天气渐渐放凉，大家最近都在忙点啥呢？
今天我们来讲点啥呢？今天给大家分享一个排序示例。
相应大家在平时开发中，都会用到连续窗体，但我们在用连续窗体时，如果遇到排序问题，对于连续窗体就比较麻烦，不像数据表窗体，可以直接下拉选择排序，OK，那我们来看看怎么实现。
01、表设计
首先，我们还是一样，先来创建一张表，当然如果你有现成的表，可以跳过这一步。
表创建后，我们还需要添加一些测试数据。
02、创建窗体
这里，我们就需要用我们刚刚创建的表做为数据源来创建一个连续窗体了。
接着，我们再添加一个按钮，放一个排序按钮，按钮名称为：btnSort
03、添加类
这里我们封装了一个类，我们把这个源码给到大家，大家复制一下代码，把下面的代码放到类模块里面就可以了。
Option Explicit
Private m_frmCurrentForm As Object
Private m_ctlCurrentSortField As Control
Private m_ctlCurrentSortButton As Control
Private m_ctlPrevSortField As Control
Private m_ctlPrevSortButton As Control
Const SORT_DESC = "D" 'Created for easy code reading of
Const SORT_ASC = "A" 'sort status (numbers were random chosen)
Const SORT_NONE = "N" 'Status stored in sorted field's .Tag property
Public Property Get CurrentForm() As Object
On Error GoTo Property_Err
Set CurrentForm = m_frmCurrentForm
Exit Property
Property_Exit:
Exit Property
Property_Err:
MsgBox "The following error occurred In Property Get CurrentForm: " & Error$
Resume Property_Exit
End Property
Public Property Set CurrentForm(frm As Object)
On Error GoTo Property_Err
Set m_frmCurrentForm = frm
Exit Property
Property_Exit:
Exit Property
Property_Err:
MsgBox "The following error occurred In Property Set CurrentForm: " & Error$
Resume Property_Exit
End Property
Public Sub GoSort()
On Error GoTo GoSort_Err
Const NAVY = 10040115 'Default button caption color (not sorted)
Const RED = 255 'Sorted Ascending button caption color
Const GREEN = 32768 'Sorted Descending button caption color
Dim fFirstSort As Boolean
Dim fChangeSortColumn As Boolean
'If no data to sort the exit
If Me.CurrentForm.RecordsetClone.RecordCount = 0 Then
Exit Sub
End If
'Initialize booleans
fFirstSort = False
fChangeSortColumn = False
On Error Resume Next
If PrevSortField <> Me.CurrentSortField Then
'Sort is on a new column
If Err <> 0 Then
Err.Clear
fFirstSort = True
Else
fChangeSortColumn = True
With PrevSortButton
.ForeColor = NAVY
.ControlTipText = ""
End With
End If
End If
On Error GoTo GoSort_Err
Select Case Me.CurrentSortField.Tag 'Choices are 'D', 'A', or 'N'
Case SORT_ASC
Me.CurrentForm.Form.OrderBy = "[" & Me.CurrentSortField.ControlSource & "]" & " DESC"
Me.CurrentSortField.Tag = SORT_DESC
With Me.CurrentSortButton
.ForeColor = GREEN
.ControlTipText = "Sorted Descending by " & .Caption
End With
Case SORT_DESC
Me.CurrentForm.Form.OrderBy = "[" & Me.CurrentSortField.ControlSource & "]"
Me.CurrentSortField.Tag = SORT_ASC
With Me.CurrentSortButton
.ForeColor = RED
.ControlTipText = "Sorted Ascending by " & .Caption
End With
Case Else 'Not sorted or .Tag = ""
Me.CurrentForm.OrderBy = "[" & Me.CurrentSortField.ControlSource & "]"
Me.CurrentSortField.Tag = SORT_ASC
With Me.CurrentSortButton
.ForeColor = RED
.ControlTipText = "Sorted Ascending by " & .Caption
End With
End Select
If fChangeSortColumn Then
PrevSortField.Tag = SORT_NONE
End If
Set PrevSortField = Me.CurrentSortField
Set PrevSortButton = Me.CurrentSortButton
Exit Sub
GoSort_Exit:
Exit Sub
GoSort_Err:
MsgBox "The following error occurred In Sub GoSort: " & Error$
Resume GoSort_Exit
End Sub
Public Property Set CurrentSortField(ctl As Control)
On Error GoTo Property_Err
Set m_ctlCurrentSortField = ctl
Exit Property
Property_Exit:
Exit Property
Property_Err:
MsgBox "The following error occurred In Property Set CurrentSortField: " & Error$
Resume Property_Exit
End Property
Private Property Set PrevSortField(ctl As Control)
On Error GoTo Property_Err
Set m_ctlPrevSortField = ctl
Exit Property
Property_Exit:
Exit Property
Property_Err:
MsgBox "The following error occurred In Property Set PrevSortField: " & Error$
Resume Property_Exit
End Property
Private Property Set PrevSortButton(ctl As Control)
On Error GoTo Property_Err
Set m_ctlPrevSortButton = ctl
Exit Property
Property_Exit:
Exit Property
Property_Err:
MsgBox "The following error occurred In Property Set PrevSortButton: " & Error$
Resume Property_Exit
End Property
Private Property Get PrevSortField() As Object
On Error GoTo Property_Err
Set PrevSortField = m_ctlPrevSortField
Exit Property
Property_Exit:
Exit Property
Property_Err:
MsgBox "The following error occurred In Property Get PrevSortField: " & Error$
Resume Property_Exit
End Property
Public Property Get CurrentSortField() As Control
On Error GoTo Property_Err
Set CurrentSortField = m_ctlCurrentSortField
Exit Property
Property_Exit:
Exit Property
Property_Err:
MsgBox "The following error occurred In Property Get CurrentSortField: " & Error$
Resume Property_Exit
End Property
Public Property Get CurrentSortButton() As Control
On Error GoTo Property_Err
Set CurrentSortButton = m_ctlCurrentSortButton
Exit Property
Property_Exit:
Exit Property
Property_Err:
MsgBox "The following error occurred In Property Get CurrentSortButton: " & Error$
Resume Property_Exit
End Property
Private Property Get PrevSortButton() As Control
On Error GoTo Property_Err
Set PrevSortButton = m_ctlPrevSortButton
Exit Property
Property_Exit:
Exit Property
Property_Err:
MsgBox "The following error occurred In Property Get PrevSortButton: " & Error$
Resume Property_Exit
End Property
Public Property Set CurrentSortButton(ctl As Control)
On Error GoTo Property_Err
Set m_ctlCurrentSortButton = ctl
Exit Property
Property_Exit:
Exit Property
Property_Err:
MsgBox "The following error occurred In Property Set CurrentSortButton: " & Error$
Resume Property_Exit
End Property
Private Sub Class_Initialize()
On Error Resume Next
If Not Me.CurrentForm.Form.OrderByOn Then
Me.CurrentForm.Form.OrderByOn = True
End If
End Sub
Private Sub Class_Terminate()
On Error Resume Next
Screen.ActiveForm.Form.OrderBy = ""
End Sub04、调用类
接着，我们就要来调用类了，分几步，具体的代码如下：
Option Explicit
‘先申明
Dim oSort As New clsSort
Private Sub btnSort_Click()
‘按钮的单击里去调用
With oSort
Set .CurrentSortButton = Me.btnSort
Set .CurrentSortField = Me!物料代码
.GoSort
End With
End Sub
’在加载事件里初始化
Private Sub Form_Load()
Set oSort = New clsSort
Set oSort.CurrentForm = Me
End Sub05、测试使用
最后就是测试了，我们来看一下效果。
好的，大家快去试一下吧！
