【译文】如何为一个组合框或列表框添加全选按钮

时　间:2013-08-27 14:55:08
作　者:周芳   ID：24526  城市：上海
摘　要:当你使用一个列表框或组合框,用来选择输入的记录,您可能希望能够指定所有的记录。这个AddAllToList方法说明了如何在顶部的一个组合框添加一个(全选)条目。
正　文:

来自：微软  翻译：周芳

【译文】如何为一个组合框或列表框添加全选按钮

      当你使用一个列表框或组合框,用来选择输入的记录,您可能希望能够指定所有的记录。这个AddAllToList方法说明了如何在顶部的一个组合框添加一个(全选)条目。

      利用AddAllToList方法,您必须设置RowSourceType属性的组合框或列表框来AddAllToList。
除了添加（全选）到列表,你还可以通过设置组合框或列表框的标签属性来指定一个不同的项目。例如,您可以通过设置标记的值属性1;<全不选>来添加<全不选>到列表的顶部。

VBA代码：

Function AddAllToList(ctl As Control, lngID As Long, lngRow As Long, _
lngCol As Long, intCode As Integer) As Variant
 
Static dbs As Database, rst As Recordset
Static lngDisplayID As Long
Static intDisplayCol As Integer
Static strDisplayText As String
Dim intSemiColon As Integer
 
On Error GoTo Err_AddAllToList
Select Case intCode
Case acLBInitialize
' 看看函数是否已经在使用
If lngDisplayID <> 0 Then
MsgBox "AddAllToList is already in use by another control!"
AddAllToList = False
 
Exit Function
End If
 
' 从标签属性分析出显示列和显示文本。
intDisplayCol = 1
strDisplayText = "(All)"
If ctl.Tag <> "" Then
intSemiColon = InStr(ctl.Tag, ";")
If intSemiColon = 0 Then
intDisplayCol = Val(ctl.Tag)
Else
intDisplayCol = Val(Left(ctl.Tag, intSemiColon - 1))
strDisplayText = Mid(ctl.Tag, intSemiColon + 1)
 
End If
End If
 
' 从行来源属性打开确定的记录集。

Set dbs = CurrentDb
Set rst = dbs.OpenRecordset(ctl.RowSource, dbOpenSnapshot)
 
'  为这个函数记录并返回lngID。
lngDisplayID = Timer
AddAllToList = lngDisplayID
 
Case acLBOpen
AddAllToList = lngDisplayID
 
Case acLBGetRowCount
' 返回记录集的行数.
On Error Resume Next
 
rst.MoveLast
AddAllToList = rst.RecordCount + 1
 
Case acLBGetColumnCount
' 返回数字的字段(列)在记录集.
AddAllToList = rst.Fields.Count
 
Case acLBGetColumnWidth
AddAllToList = -1
 
Case acLBGetValue
If lngRow = 0 Then
If lngCol = intDisplayCol - 1 Then
AddAllToList = strDisplayText
Else
AddAllToList = Null
End If
Else
 
rst.MoveFirst
rst.Move lngRow - 1
AddAllToList = rst(lngCol)
End If
Case acLBEnd
lngDisplayID = 0
rst.Close
End Select
 
Bye_AddAllToList:
Exit Function
 
Err_AddAllToList:
MsgBox Err.Description, vbOKOnly + vbCritical, "AddAllToList"
AddAllToList = False
Resume Bye_AddAllToList
End Function

原文：How to: Add "(All)" to a Combo Box or List Box

      When you use a list box or combo box to enter selection criteria, you might want to be able to specify all records. The AddAllToList procedure illustrates how to add an (All) entry at the top of a combo box.

      To utilize the AddAllToList procedure, you must set the RowSourceType property of the combo box or list box to AddAllToList.

      You can specify a different item than (All) to add to the list by setting the Tag property of the combo box or list box. For example, you can add <None> to the top of the list by setting the value of the Tag property to 1;<None>.

VBA
Function AddAllToList(ctl As Control, lngID As Long, lngRow As Long, _
lngCol As Long, intCode As Integer) As Variant
 
Static dbs As Database, rst As Recordset
Static lngDisplayID As Long
Static intDisplayCol As Integer
Static strDisplayText As String
Dim intSemiColon As Integer
 
On Error GoTo Err_AddAllToList
Select Case intCode
Case acLBInitialize
' See if function is already in use.
If lngDisplayID <> 0 Then
MsgBox "AddAllToList is already in use by another control!"
AddAllToList = False
 
Exit Function
End If
 
' Parse the display column and display text from Tag property.
intDisplayCol = 1
strDisplayText = "(All)"
If ctl.Tag <> "" Then
intSemiColon = InStr(ctl.Tag, ";")
If intSemiColon = 0 Then
intDisplayCol = Val(ctl.Tag)
Else
intDisplayCol = Val(Left(ctl.Tag, intSemiColon - 1))
strDisplayText = Mid(ctl.Tag, intSemiColon + 1)
 
End If
End If
 
' Open the recordset defined in the RowSource property.
Set dbs = CurrentDb
Set rst = dbs.OpenRecordset(ctl.RowSource, dbOpenSnapshot)
 
' Record and return the lngID for this function.
lngDisplayID = Timer
AddAllToList = lngDisplayID
 
Case acLBOpen
AddAllToList = lngDisplayID
 
Case acLBGetRowCount
' Return number of rows in recordset.
On Error Resume Next
 
rst.MoveLast
AddAllToList = rst.RecordCount + 1
 
Case acLBGetColumnCount
' Return number of fields (columns) in recordset.
AddAllToList = rst.Fields.Count
 
Case acLBGetColumnWidth
AddAllToList = -1
 
Case acLBGetValue
If lngRow = 0 Then
If lngCol = intDisplayCol - 1 Then
AddAllToList = strDisplayText
Else
AddAllToList = Null
End If
Else
 
rst.MoveFirst
rst.Move lngRow - 1
AddAllToList = rst(lngCol)
End If
Case acLBEnd
lngDisplayID = 0
rst.Close
End Select
 
Bye_AddAllToList:
Exit Function
 
Err_AddAllToList:
MsgBox Err.Description, vbOKOnly + vbCritical, "AddAllToList"
AddAllToList = False
Resume Bye_AddAllToList
End Function