访问选项卡控件 - 根据子表单记录

Question

我知道怎么做，但想知道我是否能写出更优雅的解决方案。我有一个带有标签控件的表单。该控件有14页，每页都有自己的子表单。其中一个页面（pgRequirements）有一个需求子表单，其组合控件为“需求类型”。它是一种连续的形式，因此用户可以根据需要为主记录添加任意数量的要求。

这些要求中有9个，它们有自己的标签控制页面/子表单。我想根据父项的子表单要求设置这些选项卡控件页面的可见性。所以当前的主记录，可以有多个子需求记录。如果任何一个匹配，例如要求类型A，而不是页面A应该是可见的，否则它不应该是可见的。

我需要在加载主表单的任何时候运行此代码，并使详细信息可见（意味着已从查找表单中选择主记录）。也可以随时添加或删除需求记录。下面假设主窗体上的父子链接将子请求记录限制为当前主记录的那些。

这是一个简单的代码，可以完成这项工作，但可能已经覆盖了：

If Me.FKRequirementType.Column(1) = "ReqType1" Then
    Me.Parent!pgReqType1.Visible = True
Else
    Me.Parent!pgReqType1.Visible = False
End If

If Me.FKRequirementType.Column(1) = "ReqType2" Then
    Me.Parent!pgReqType2.Visible = True
Else
    Me.Parent!pgReqType2.Visible = False
End If

If Me.FKRequirementType.Column(1) = "ReqType3" Then
    Me.Parent!pgReqType3.Visible = True
Else
    Me.Parent!pgReqType3.Visible = False
End If

If Me.FKRequirementType.Column(1) = "ReqType4" Then
    Me.Parent!pgReqType4.Visible = True
Else
    Me.Parent!pgReqType4.Visible = False
End If

谢谢！

修改

我把它变成了一个公共函数，所以我可以从任何地方调用它。一个问题。它不工作大声笑（小问题）。我没有收到任何错误，但所有选项卡控件页面都可见。当我添加新记录时，大多数记录应该被隐藏。我有一个tblReqType表，包含所有需求类型。我在其中添加了一个列，其中包含相应选项卡控件页面名称的确切名称，因此我可以遍历该表，对于该页面名称不为空的所有记录，并根据当前设置其页面是否可见主记录ID，具有每种需求类型的记录要求（交叉引用表）记录。

这是我写的公共功能。任何人都可以帮助我理解我在这些循环中缺少的设置可见性为真（vtrue）与设置可见性为假（vfalse）

Public Function ShowRequirements()
    Dim db As DAO.Database
    Dim strRstVTrue As String
    Dim rstvTrue As DAO.Recordset
    Dim strRstVFalse As String
    Dim rstvFalse As DAO.Recordset
    Dim strFieldName As String

    'Setup the recordset
    Set db = CurrentDb
    strRstVTrue = "SELECT tblMRecordRequirements.ID, tblMRecordRequirements.FKMC, tblReqType.txtRequirementPage " & _
    "FROM tblMRecordRequirements LEFT JOIN tblReqType ON tblMRecordRequirements.FKRequirementType = tblReqType.ID " & _
    "WHERE tblReqType.txtRequirementPage Is Not Null AND tblMRecordRequirements.FKMC = " & Nz(Forms!frmMRecords!ID, 0)

    strRstVFalse = "SELECT tblReqType.ID, tblReqType.txtRequirementPage, tblMRecordRequirements.FKMC " & _
    "FROM tblReqType LEFT JOIN tblMRecordRequirements ON tblReqType.ID = tblMRecordRequirements.FKRequirementType " & _
    "WHERE tblReqType.txtRequirementPage Is Not Null AND tblMRecordRequirements.FKMC <> " & Nz(Forms!frmMRecords!ID, 0)

    Set rstvTrue = CurrentDb.OpenRecordset(strRstVTrue, dbOpenDynaset, dbSeeChanges)
    Set rstvFalse = CurrentDb.OpenRecordset(strRstVFalse, dbOpenDynaset, dbSeeChanges)
    strFieldName = "txtRequirementPage"
    Do While Not rstvTrue.EOF
        Forms!frmMRecords.tbMRecordSubs.Pages(rstvTrue.Fields(strFieldName)).Visible = True
    Loop
    Do While Not rstvFalse.EOF
        Forms!frmMRecords.tbMRecordSubs.Pages(rstvFalse.Fields(strFieldName)).Visible = False
    Loop
End Function

如果有人能帮助我弄清楚我的愚蠢，你应该得到一个投票，一个复选标记和一个cookie。

再次编辑

以下是公共功能的更新代码。我为真正的查询修复了rs，并在MoveNext中添加了循环。

Public Function ShowRequirements（）         Dim db作为DAO.Database         Dim strRstVTrue As String         Dim rstvTrue作为DAO.Recordset         Dim strRstVFalse As String         Dim rstvFalse作为DAO.Recordset         Dim strFieldName As String

    'Setup the recordset
    Set db = CurrentDb
    strRstVTrue = "SELECT tblMRecordRequirements.ID, tblMRecordRequirements.FKMC, tblReqType.txtRequirementPage " & _
    "FROM tblMRecordRequirements LEFT JOIN tblReqType ON tblMRecordRequirements.FKRequirementType = tblReqType.ID " & _
    "WHERE tblReqType.txtRequirementPage Is Not Null AND tblMRecordRequirements.FKMC = " & Nz(Forms!frmMRecords!ID, 0)

    strRstVFalse = "SELECT tblReqType.ID, tblReqType.txtRequirementPage, tblMRecordRequirements.FKMC " & _
    "FROM tblReqType LEFT JOIN tblMRecordRequirements ON tblReqType.ID = tblMRecordRequirements.FKRequirementType " & _
    "WHERE tblReqType.txtRequirementPage Is Not Null AND tblMRecordRequirements.FKMC <> Is Null"

    Set rstvTrue = CurrentDb.OpenRecordset(strRstVTrue, dbOpenDynaset, dbSeeChanges)
    Set rstvFalse = CurrentDb.OpenRecordset(strRstVFalse, dbOpenDynaset, dbSeeChanges)
    strFieldName = "txtRequirementPage"
    Do While Not rstvTrue.EOF
        Forms!frmMRecords.tbMRecordSubs.Pages(rstvTrue.Fields(strFieldName)).Visible = True
    rstvTrue.MoveNext
    Loop
    Do While Not rstvFalse.EOF
        Forms!frmMRecords.tbMRecordSubs.Pages(rstvFalse.Fields(strFieldName)).Visible = False
    rstvFalse.MoveNext
    Loop
End Function

编辑REDUX

我想我可能已经解决了，但让我知道你们都在想什么。我非常感谢你对此的所有想法，因为我知道你们都有很多经验，不仅要弄清楚这些挑战，还要确保代码是好的，不容易出问题。

我在这里：

Public Function ShowRequirements()
    Dim db As DAO.Database
    Dim db2 As DAO.Database
    Dim strRstVTrue As String
    Dim rstvTrue As DAO.Recordset
    Dim strRstVFalse As String
    Dim rstvFalse As DAO.Recordset
    Dim strFieldName As String

    strFieldName = "txtRequirementPage"
    Set db = CurrentDb
    Set db2 = CurrentDb

    strRstVTrue = "SELECT tblReqType.txtRequirementPage " & _
    "FROM tblReqType LEFT JOIN tblMRecordRequirements ON tblMRecordRequirements.FKRequirementType = tblReqType.ID " & _
    "WHERE tblReqType.txtRequirementPage Is Not Null AND tblMRecordRequirements.FKMC = " & MCID

    strRstVFalse = "SELECT tblReqType.txtRequirementPage " & _
    "FROM tblReqType LEFT JOIN tblMRecordRequirements ON tblMRecordRequirements.FKRequirementType = tblReqType.ID " & _
    "WHERE tblMRecordRequirements.ID Not In (Select ID From [tblMRecordRequirements] WHERE [tblMRecordRequirements]![FKMC] = " & MCID & _
    ") AND tblReqType.txtRequirementPage Is Not Null;"

    Set rstvTrue = db.OpenRecordset(strRstVTrue, dbOpenDynaset, dbSeeChanges)
    Set rstvFalse = db2.OpenRecordset(strRstVFalse, dbOpenDynaset, dbSeeChanges)
    Do While Not rstvTrue.EOF
        Forms!frmMRecords.tbMRecordSubs.Pages(rstvTrue.Fields(strFieldName)).Visible = True
    rstvTrue.MoveNext
    Loop
    Do While Not rstvFalse.EOF
        Forms!frmMRecords.tbMRecordSubs.Pages(rstvFalse.Fields(strFieldName)).Visible = False
    rstvFalse.MoveNext
    Loop
End Function

Answer 1

  

我需要在加载主表单的任何时候运行此代码，并使详细信息可见（意味着已从查找表单中选择主记录）。也可以随时添加需求记录。

将您共享的代码放在子过程中，并从Form_Load（），Form_Current（），Form_AfterInsert（）事件处理程序等调用子过程。

至于优雅，我专注于可维护性和效率而不是外观，但简洁的代码也很好。 1）您可以使用With块来减少冗余对象方法调用，但这一次只能用于一个引用。 2）而是创建另一个变量来临时保存一系列点属性访问器中的值/对象。 3）看起来页面和列值已经使用一致的命名模式进行编号，因此在循环中利用它。 4）VBA中的比较操作主要是布尔运算，因此它们返回True或False。整个布尔表达式的结果可以分配给另一个布尔变量/属性。 （布尔运算也可以返回Null ...这通常但不总是被视为False。如果你确定你的数据没有Null值，那么你可以简化代码并忽略它如果数据可以包含null，那么您需要适当地调整代码。）

Me.Parent!pgReqType1正在调用父表单的默认属性，即控件，其默认属性为Item。砰的操作员！将代码文本作为字符串传递到集合Item方法中。简而言之，它相当于Me.Parent.Controls.Item("pgReqType1")。

Dim i as integer
Dim ctls as Controls
Dim reqValue as string

Set ctls = Me.Parent.Controls
reqValue = Me.FKRequirementType.Column(1)

For i = 1 to 4
  ctls.Item("pgReqType" & i).Visible = (reqValue = "ReqType" & i)
Next i

我可以做的就是翻译您显示的特定代码段。我觉得可能还有更多，因为你共享的代码片段确保只有一个标签可见：它正在多次测试相同的列值，只能有一个值。错误？不完整的例子？

Answer 2

这实际上违背了我对Stack Overflow原则的更好判断 - 不回答多部分，继续调试问题 - 但我真的想要一个cookie。

发布的代码怎么可能有效，因为你没有通过任何记录集？没有MoveNext来电。这意味着两个记录集都是空的，或者抛出了一个在某处被忽略的错误（即On Error Resume Next）。否则，它应该使用无限循环锁定Access。有时您可以使用Ctrl + Break停止代码，但在Access中并不总是成功。

正确解释您的数据需要更精确的表格架构，但我会做出一些假设。您声明tblReqType包含所有需求类型。我假设tblMRecordRequirements仅包含针对tblMRecordRequirements.FKMC中ID值“已应用”（a.k.a。“on”，“selected”）的要求的行。假设相反，如果给定tblMRecordRequirements的{​​{1}}中的tblMRecordRequirements.FKMC中没有ID为tblMRecordRequirements.FKRequirementType的行，则该要求不会“应用”到该ID。

tblReqType中的每一行都有txtRequirementPage中的值，或某些行是否有空值？此外，多个要求可以指定相同的页面吗？或者它是一个真正的一对一需求到页面映射，没有空值？

首先，为什么第一个查询不是INNER JOIN，因为我假设只有两个表中匹配的记录才能返回Visible = True条件？根据您上面的答案，这可能会使第一个查询中的条件tblReqType.txtRequirementPage Is Not Null变得不必要。

如果选择所有其他ID值（tblMRecordRequirements.FKMC <> Nz(Forms!frmMRecords!ID, 0)），简单地反转LEFT JOIN将不会返回您想要的内容。所有这一切都是为了满足每个其他ID值的要求。这不仅效率低，因为它可以返回许多很多不相关的记录，可能会在所有其他ID值上应用每个可能的需求，因此第二个查询将基本上导致所有需求都不可见。

进一步挑剔的观察：

• 如果Forms！frmMRecords！ID为null，那么您甚至可以不执行查询。您应该单独检查该值的null并执行适当的操作，而不是让该特定条件通过其他代码，即使最终副作用是您想要的。它使代码更难以正确调试和解释。换句话说，编写“如果ID为null，将所有页面设置为visible = false，然后退出sub（即跳过其他代码）”的代码“
• 获取只读快照而不是完全可更新的动态集动态记录集更有效：过多的开销只是为了在没有数据操作的情况下进行循环。
• 正确的断点，调试输出和错误处理代码可以帮助识别错误的代码。值得手动跟踪记录集的结果以检查值和正确的SQL语法。

试试这个：

Public Sub ShowRequirements()
    Dim db As DAO.Database
    Dim iID As Long '? Assuming long integer
    Dim strSQL As String
    Dim rsTabs As DAO.Recordset

    On Error Resume Next
    iID = -1 '* Set to bogus value
    If Not IsNull(Forms!frmMRecords!ID) Then
      iID = Forms!frmMRecords!ID
    End If

    If iID = -1 Or Err.Number <> 0 Then
      '* Problem accessing ID control on form (empty recordset, new record row, etc.)
      '*  or it is null

      'Set all tab pages to Visible = False?
      Exit Sub
    End If

    On Error GoTo Catch
    '* Setup the recordset
    Set db = CurrentDb

    '* Use embedded query (replacable with saved query) for filtering on ID values.
    '* This is critical so that the LEFT JOIN does not return or filter records
    '* based on other ID values.
    strSQL = _
      "SELECT tblReqType.ID, tblReqType.txtRequirementPage, (IDReq.FKRequirementType Is Not Null) As ShowTab " & _
      " FROM tblReqType LEFT JOIN" & _
        " (SELECT MReq.FKRequirementType FROM tblMRecordRequirements AS MReq " & _
          " WHERE MReq.FKMC = " & iID & ") AS IDReq" & _
        " ON tblReqType.ID = IDReq.FKRequirementType" & _
        " WHERE tblReqType.txtRequirementPage Is Not Null"

    Set rsTabs = db.OpenRecordset(strRstVTrue, dbOpenSnapshot, dbReadOnly)
    Do While Not rsTabs.EOF
        Forms!frmMRecords.tbMRecordSubs.Pages(rsTabs!txtRequirementPage).Visible = rsTabs!ShowTab
        rsTabs.MoveNext '* Advance recordset.  (Avoid infinite loops.)
    Loop

CloseAll:
    On Error Resume Next
    '* Best habit to explicitly close recordsets and database connections, even when not necessary (since they'll close automatically when they go out of scope)
    If Not rsTabs Is Nothing Then
      rsTabs.Close
      Set rsTabs = Nothing
    End If
    Set db = Nothing

    Exit Sub
Catch:
    '* At least report error for development
    Debug.Print "ShowRequirements(): Error: " & Err.Number & ": " & Err.Description

    '* Show MsgBox or update form status control?
    '* Set all tab pages to Visible = False?
    '* Form state could be misleading without proper user notification and/or error handling

    Resume CloseAll
End Sub