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

时间:2018-07-17 12:44:58

标签: sql vba ms-access access-vba subform

我知道我正在寻找一种快速修复,并且主要问题在数据库设计中,但目前我对此无能为力。 所以这是我的愿望:

我有三个表TableA,TableB,TableC,它们都共享ID作为键,并且已启用了引用完整性(事实上,这将是一个大型表,具有超过255列,这是我必须找到一种解决方法的限制)。我想要实现的是将所有记录同时显示为数据表,并且具有以下行为:

  • 如果我在表A中进行过滤,则表B和表C应该显示相同的行
  • 排序也应相等,并应由表A中的某些列完成
  • 我已经设法使光标位于所有表的同一行中

desired layout

我想到了在该记录集上进行一个webHttpBinding或某种联接,但未能实现。

作为一个旁注:该数据库中大约有10万条记录,并且性能必须要快,因为该视图主要用于需要这样的平面数据结构的多个库和行上的数据输入/更新。

在此先感谢您的帮助!

2 个答案:

答案 0 :(得分:3)

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

因为您已将子表单直接绑定到表,所以您无法监听事件。但是,我最近encountered that issue遇到了麻烦的解决方法,但是如果您的字段名和表名是恒定的,则不需要使用它。您只需要用数据表形式包装TableA。

打开 TableA ,然后转到 Create 标签,然后进入更多表单-> 数据表。现在,您具有一个数据表表单,该表单可以捕获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个表而不是3个表

答案 1 :(得分:2)

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

  1. On Exit过滤后的任何子表单,会将ID迭代地附加到临时表中。
  2. 另两个子窗体的RecordSources过滤为临时表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