MS Access计算列表

我以前没有看到此功能的文档，因此我想与您分享此功能，因为我将在以后的文章中使用它。

对于组合框或列表框，源数据通常是表/查询。 也可以是一个值列表，一个静态数据列表。

但是，如果您的信息未保存在表中，并且它不是静态列表，该怎么办。

我使用的示例包括：“此后紧接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