Access开发培训
网站公告
·Access专家课堂QQ群号:151711184    ·Access快速开发平台下载地址及教程    ·欢迎加入Access专家课堂微信群!    ·如何快速搜索本站文章|示例|资料    
您的位置: 首页 > 技术文章 > Access数据库-模块/函数/VBA

向组合框或列表框添加“(All)”

时 间:2021-11-15 08:45:14
作 者:杨雪   ID:42182  城市:南京
摘 要:向组合框或列表框添加“(All)”
正 文:

使用列表框或组合框输入选择条件时,您可能希望能够指定所有记录。 AddAllToList 过程说明了如何在组合框顶部添加 (All) 项。

要使用 AddAllToList 过程,必须将组合框或列表框的 RowSourceType 属性设置为 AddAllToList。

可以通过设置组合框或列表框的 Tag 属性来指定要添加到列表中的 (All) 以外的项。 例如,可以通过将 Tag 属性的值设置为 添加到列表 <None> 顶部 1;<None> 。

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


Access软件网官方交流QQ群 (群号:54525238)       Access源码网店

常见问答:

技术分类:

相关资源:

专栏作家

关于我们 | 服务条款 | 在线投稿 | 友情链接 | 网站统计 | 网站帮助