在表单内的Access中的三个子表单中显示基于相同ID的记录
Show records based on same id in three subforms in Access within a form
我知道我正在寻找快速修复方法,主要问题出在数据库设计上,但目前我无能为力。
所以这是我的愿望:
我有三个 tables TableA、TableB、TableC 都共享 ID 作为密钥并启用了参照完整性(事实上它是一个大的 table 超过 255 列,这是我必须找到解决方法的限制)。我想要实现的是将所有记录同时显示为彼此相邻的数据table并具有以下行为:
- 如果我过滤 table A,Table B 和 C 应该显示相同的行
- 排序也应该相等,并且应该按 Table A
中的某些列进行排序
- 我已经设法让光标在所有 tables
的同一行中
我想在该记录集上进行 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 运行 以下例程:
On Exit
过滤后的任何子表单,ID 被迭代附加到临时 table.
- 另外两个子表单
RecordSources
过滤为临时 table ID。
- “重置”按钮会删除所有过滤器,以便 运行 不同的标准。
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
我知道我正在寻找快速修复方法,主要问题出在数据库设计上,但目前我无能为力。
所以这是我的愿望:
我有三个 tables TableA、TableB、TableC 都共享 ID 作为密钥并启用了参照完整性(事实上它是一个大的 table 超过 255 列,这是我必须找到解决方法的限制)。我想要实现的是将所有记录同时显示为彼此相邻的数据table并具有以下行为:
- 如果我过滤 table A,Table B 和 C 应该显示相同的行
- 排序也应该相等,并且应该按 Table A 中的某些列进行排序
- 我已经设法让光标在所有 tables 的同一行中
我想在该记录集上进行 select * from tableB where id in filteredrecordset of tableA
或某种连接,但未能实现。
旁注:该数据库中大约有 100k 条记录,性能必须很快,因为此视图主要用于多列和多行的数据 entry/updates,需要这种扁平的数据结构。
在此先感谢您的帮助!
您可以使用表单 On Filter
事件来同步过滤器。但是,我假设您已将子表单直接绑定到 table.
因为您已经将子表单直接绑定到 table,所以您无法监听事件。但是,我最近
打开 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 运行 以下例程:
On Exit
过滤后的任何子表单,ID 被迭代附加到临时 table.- 另外两个子表单
RecordSources
过滤为临时 table ID。 - “重置”按钮会删除所有过滤器,以便 运行 不同的标准。
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