我以前没有看到此功能的文档,因此我想与您分享此功能,因为我将在以后的文章中使用它。
对于组合框或列表框,源数据通常是表/查询。 也可以是一个值列表,一个静态数据列表。
但是,如果您的信息未保存在表中,并且它不是静态列表,该怎么办。
我使用的示例包括:“此后紧接100个质数”,“从下个月开始的每个第三个星期五”,“数据库中所有以“ tlk”开头的表”,“ MDW文件中的所有用户”以及许多计算或派生函数的其他列表。
组合框和列表框还有另一种行源类型,它使用以特定方式构造的全局递归函数。
此函数将返回由全局函数计算的单列数据。
为了使用此功能,您首先需要创建组合框或列表框,在表单上说cboLookup。
将RowSourceType保留为表/查询,但不分配RowSource。
在窗体的打开事件中,将框的RowSourceType分配给全局函数。 (该功能必须在标准模块中,而不在表单的模块中)
cboLookup.RowSourceType = "ListLookup"
然后,您必须编写函数。
此处显示的功能ListLookup返回数据库中以tlk开头的所有表的列表。
我用它来编辑查找表。
Function ListLookup(fld As Control, id, row, col, Code) As Variant
' Author Mark Fisher
' Description
' Returns a function list of all lookup tables, up to a max of 100
' Note, this can't go in a form, it must be global!!!
On Error GoTo Err_ListLookup
Static astrTables(100) As String, entries As Integer
Dim returnval As Variant
Dim i As Integer, j As Integer
Dim db As Database
Dim intCount As Integer
returnval = Null
Select Case Code
Case 0
Set db = CurrentDb
intCount = 0
For i = 0 To db.Containers.Count - 1
If db.Containers(i).Name = "Tables" Then
For j = 0 To db.Containers(i).Documents.Count - 1
If Left(db.Containers(i).Documents(j).Name, "3") = "tlk" Then
If db.Containers(i).Documents(j).Name = "tlkText" Or db.Containers(i).Documents(j).Name = "tlkTranslate" Then
'do nowt
Else
astrTables(intCount) = db.Containers(i).Documents(j).Name
intCount = intCount + 1
End If
End If
Next
End If
Next
entries = intCount
Set db = Nothing
returnval = entries
Case 1
returnval = Timer
Case 3
returnval = entries
Case 4, 5
returnval = -1
Case 6
returnval = astrTables(row)
Case 9
For entries = 0 To 100
astrTables(entries) = ""
Next
End Select
ListLookup = returnval
Exit_ListLookup:
Exit Function
Err_ListLookup:
If Not Err Then
MsgBox "Contact Support" & vbCrLf & "Error " & Err & " in ListLookup " & vbCrLf & Error$, _
16, "Error in Global Module"
Resume Exit_ListLookup
End If
End Function
- 您必须使用如图所示的调用参数,即fld作为控件,id,行,列,代码。
- 您需要一个数组来存储列表结果,我使用astrTables()。 它必须是一个静态数组(在函数退出后仍然存在),并且必须足够大以容纳最大条目。
- 就像我说的那样,必须保留案例陈述的所有结构,因为我从未见过该文献的记载,因此花了反复试验才能使它在一个杂志示例(如yonks)中起作用。
- 多次调用此函数,使用不同的Code值,不,我不知道调用什么,我只知道它的工作原理。
情况9是初始化。 这是您清空数组的地方
情况6是您返回数组的行值的地方
情况3返回要显示的条目数
在案例0中,您可以设计函数来构成列表。 在这种情况下,我遍历表容器,查找所需的表名,然后将它们添加到列表中,一路增加计数。
我不知道其他情况如何,我不理会它们,函数起作用了。
这是另一个列表函数,它返回MDW文件中属于我的“ staff”组的所有用户
Function ListUsers(fld As Control, id, row, col, Code)
' Author Mark Fisher
' Description
' Returns a function list of all users, up to a max of 300
' Note, this can't go in a form, it must be global!!!
'
On Error GoTo Err_ListUsers
Static astrUserNames(300) As String, entries As Integer
Dim returnval
Dim wks As Workspace
Dim usr As User, intGrp As Integer, onlystaff As Boolean, isStaff As Boolean, intCount As Integer
returnval = Null
Select Case Code
Case 0
Set wks = DBEngine.CreateWorkspace("", SECUREUSER, SECUREPASSWORD)
intCount = 0
For entries = 0 To wks.Users.Count - 1
isStaff = False
onlystaff = True
Set usr = wks.Users(entries)
For intGrp = 0 To usr.Groups.Count - 1
If usr.Groups(intGrp).Name = "Staff" Then
isStaff = True
ElseIf usr.Groups(intGrp).Name = "Users" Then
'ignore it
Else
onlystaff = False
End If
Next intGrp
If isStaff And onlystaff Then
astrUserNames(intCount) = wks.Users(entries).Name
intCount = intCount + 1
End If
Next entries
entries = intCount
Set usr = Nothing
wks.Close
Set wks = Nothing
returnval = entries
Case 1
returnval = Timer
Case 3
returnval = entries
Case 4, 5
returnval = -1
Case 6
returnval = astrUserNames(row)
Case 9
For entries = 0 To 300
astrUserNames(entries) = ""
Next
End Select
ListUsers = returnval
Exit_ListUsers:
Exit Function
Err_ListUsers:
If Not Err Then
MsgBox "Contact Support" & vbCrLf & "Error " & Err & " in ListUsers " & vbCrLf & Error$, _
16, "Error in Global Module"
Resume Exit_ListUsers
End Select
End Function
希望这有意义,并且对某人有用。
From: https://bytes.com/topic/access/insights/674236-ms-access-calculated-list