在表单内的Access中的三个子表单中显示基于相同ID的记录

Show records based on same id in three subforms in Access within a form

我知道我正在寻找快速修复方法,主要问题出在数据库设计上,但目前我无能为力。

所以这是我的愿望:

我有三个 tables TableA、TableB、TableC 都共享 ID 作为密钥并启用了参照完整性(事实上它是一个大的 table 超过 255 列,这是我必须找到解决方法的限制)。我想要实现的是将所有记录同时显示为彼此相邻的数据table并具有以下行为:

我想在该记录集上进行 select * from tableB where id in filteredrecordset of tableA 或某种连接,但未能实现。

旁注:该数据库中大约有 100k 条记录,性能必须很快,因为此视图主要用于多列和多行的数据 entry/updates,需要这种扁平的数据结构。

在此先感谢您的帮助!

您可以使用表单 On Filter 事件来同步过滤器。但是,我假设您已将子表单直接绑定到 table.

因为您已经将子表单直接绑定到 table,所以您无法监听事件。但是,我最近 有了一个棘手的解决方法,但如果您的字段名称和 table 名称不变,则不需要使用它。您只需要将 TableA 包装成数据表形式即可。

打开 TableA,然后转到 创建 选项卡,然后选择 更多表格 - > 数据表。您现在有一个数据表表单,可以捕获 TableA 中的所有字段。然后,将模块添加到该数据表表单。您不需要该模块中的任何代码。

然后,我们不将第一个子表单绑定到 TableA,而是将其绑定到此数据表表单。

现在,在父窗体上,我们将为过滤器设置一个事件处理程序。

在父窗体上(我假设 tableA 的子窗体控件名称是 SubA,tableB 是 SubB,TableC 是 SubC):

Private WithEvents tblAForm As Form 'Declare tblAForm to handle events

Private Sub Form_Load()
    'Initialize event handler, sync initially
    Set tblAForm = Me.Controls("subA").Form
    tblAForm.OnApplyFilter = "[Event Procedure]"
    SyncFilters 'Not needed if you're not persisting filters, which you likely aren't
End Sub

Private Sub tblAForm_ApplyFilter(Cancel As Integer, ApplyType As Integer)
    'Sync filters
    SyncFilters(ApplyType)
End Sub

Private Sub SyncFilters(ApplyType As Integer)
    Dim srcB As String
    Dim srcC As String
    Dim strFilter As String
    Dim strOrder As String
    'If filter or sort are on on TableA, we need to join in TableA for sorting and filtering
    If tblAForm.FilterOn  Or tblAForm.OrderByOn Then
        srcB = "SELECT TableB.* FROM TableB INNER JOIN TableA On TableA.ID = TableB.ID"
        srcC = "SELECT TableC.* FROM TableC INNER JOIN TableA On TableA.ID = TableC.ID"
        'Filter to SQL
        strFilter = " WHERE " & tblAForm.Filter
        'Sort to SQL
        strOrder = " ORDER BY  " & tblAForm.OrderBy
        If tblAForm.FilterOn And tblAForm.Filter & "" <> "" And ApplyType <> 0 Then
            'If the filter is on, add it
            srcB = srcB & strFilter
            srcC = srcC & strFilter
        End If
        If tblAForm.OrderByOn And tblAForm.OrderBy & "" <> "" Then
            'If order by is on, add it
            strB = srcB & strOrder
            srcC = srcC & strOrder
        End If
    Else
        srcB = "SELECT TableB.* FROM TableB"
        srcC = "SELECT TableC.* FROM TableC"
    End If
    If srcB <> Me.SubB.Form.RecordSource Then Me.SubB.Form.RecordSource = srcB
    If srcC <> Me.SubC.Form.RecordSource Then Me.SubC.Form.RecordSource = srcC
End Sub

请注意,您确实需要一些备用字段以允许过滤和排序。用于此目的的任何字段都计入最多 255 个字段。如果你可能会碰到那个,你可以考虑将数据集分成 4 tables 而不是 3

考虑使用 RecordSourceClone 属性 和临时 table ID 运行 以下例程:

  1. On Exit 过滤后的任何子表单,ID 被迭代附加到临时 table.
  2. 另外两个子表单 RecordSources 过滤为临时 table ID。
  3. “重置”按钮会删除所有过滤器,以便 运行 不同的标准。

VBA

Option Compare Database
Option Explicit

' RESET ALL SUBFORMS
Private Sub RESET_Click()
    Me.Controls("frm_TableA").Form.RecordSource = "TableA"
    Me.Controls("frm_TableB").Form.RecordSource = "TableB"
    Me.Controls("frm_TableC").Form.RecordSource = "TableC"
End Sub

Private Sub frm_TableA_Exit(Cancel As Integer)
    Call RunFilters("frm_TableA", "frm_TableB", "frm_TableC")
End Sub

Private Sub frm_TableB_Exit(Cancel As Integer)
    Call RunFilters("frm_TableB", "frm_TableA", "frm_TableC")
End Sub

Private Sub frm_TableC_Exit(Cancel As Integer)
    Call RunFilters("frm_TableC", "frm_TableA", "frm_TableB")
End Sub

Function RunFilters(curr_frm As String, frm1 As String, frm2 As String)
On Error GoTo ErrHandler

    Dim rst As Recordset, tmp As Recordset

    ' DELETE PREVIOUS TEMP
    CurrentDb.Execute "DELETE FROM IDTempTable", dbFailOnError
    Set tmp = CurrentDb.OpenRecordset("IDTempTable")

    ' RETRIEVE FILTERED FORM RECORDSOURCE
    Set rst = Me.Controls(curr_frm).Form.RecordsetClone

    ' ITERATIVELY ADD IDs
    Do While Not rst.EOF
        With tmp
            .AddNew
                !ID = rst![ID]
            .Update
            rst.MoveNext
        End With
    Loop

    tmp.Close: rst.Close
    Set tmp = Nothing: Set rst = Nothing

    ' FILTER OTHER FORMS
    Me.Controls(frm1).Form.RecordSource = "SELECT * FROM " & Replace(frm1, "frm_", "") & _
                                            &  " WHERE [ID] IN (SELECT ID FROM IDTempTable)"
    Me.Controls(frm2).Form.RecordSource = "SELECT * FROM " & Replace(frm2, "frm_", "") & _
                                            & " WHERE [ID] IN (SELECT ID FROM IDTempTable)"        
ExitHandler:
    Exit Function

ErrHandler:
    MsgBox Err.Number & " - " & Err.Description, vbCritical, "RUN-TIME ERROR"
    Resume ExitHandler
End Function