同步访问屏幕行上的两个数据表

时间:2015-03-05 05:26:35

标签: ms-access subform

我使用子表格数据表模式来显示表格。如果我只使用一个子表单,那么表格会很宽。我会将字段分成几组。每个组将显示一个子表单,每个子表单将位于选项卡控件的选项卡中。如何在屏幕行上同步每个子表单?例如,用户滚动子表单A和行12~23现在在屏幕上,而第15行被选中。我可以在屏幕上设置其他子窗体到第12~23行,也可以选择第15行?这意味着所有子表单显示行和所选行都是同步的。

1 个答案:

答案 0 :(得分:1)

在主窗体上放置一个文本框,比如txtSyncSubforms。

将此控制源应用于它:

=SyncSubforms([subControlFirst]![ID],[subControlSecond]![ID], .., [subControlLast]![ID])

将subControlxxxx和ID替换为子窗体控件的实际名称和ID,当然,ID必须是唯一的。

在表单后面添加以下代码:

Option Compare Database
Option Explicit

' Sync multiple subforms.
' 2012-06-27. Cactus Data ApS, CPH

    ' Index for Split to separate the name of the subform control from
    ' the name of the control with the key.
    '   [subControlAny]![ID]
    ' will be split into:
    '   [subControlAny]
    ' and:
    '   [ID]
    Enum ControlName
        SubForm = 0
        Key = 1
    End Enum

Private Function SyncSubforms(ParamArray sControls() As Variant) As Variant

' Array sControls() holds the values of the key controls on the subform controls
' to be held in sync.

    ' Name of visible textbox on main form bound to this function.
    Const cControl  As String = "txtSyncSubforms"

    ' Static to store the value of the key of the last synced record.
    Static wLastID  As Variant

    Dim rst         As DAO.Recordset
    Dim wSubform    As Form

    ' Array to hold the names of the subform controls and key controls.
    Dim aControls() As String

    Dim bmk         As Variant
    Dim wNew        As Boolean
    Dim wThisID     As Variant
    Dim wIndex      As Integer

    ' If any key value is Null, we have moved to a new record.
    ' No syncing shall take place.
    For wIndex = LBound(sControls()) To UBound(sControls())
        wThisID = sControls(wIndex).Value
        If IsNull(wThisID) Then
            ' New record. Don't sync.
            wNew = True
            Exit For
        ElseIf IsNull(wLastID) Then
            ' Initial opening of form.
            ' Set wLastID to the value of the current key of the first subform.
            wLastID = wThisID
            ' Stop further processing.
            wNew = True
            Exit For
        ElseIf wThisID <> wLastID Then
            ' This key is the new value to sync the other subforms to.
            ' Store the current key.
            wLastID = wThisID
            Exit For
        End If
    Next

    If wNew = True Then
        ' New record or initial opening. Do nothing.
    Else
        ' ControlSource of cControl will read like:
        '   =SyncSubforms([subControlFirst]![ID],[subControlSecond]![ID], .., [subControlLast]![ID])
        '
        ' Build array of the names of the subform controls with the key controls:
        '   [subControlFirst]![ID]
        '   [subControlSecond]![ID]
        '   ...
        '   [subControlAny]![ID]
        '   ...
        '   [subControlLast]![ID]
        ' by extracting arg names between "(" and ")".
        aControls = Split(Replace(Split(Me(cControl).ControlSource, "(")(1), ")", ""), ",")

        ' Loop to locate and sync those subforms that haven't changed.
        For wIndex = LBound(aControls()) To UBound(aControls())
            If sControls(wIndex) <> wThisID Then
                ' This subform is to be synced.
                ' Extract name of subform control using Split:
                '   [subControlAny]
                Set wSubform = Me(Split(aControls(wIndex), "!")(ControlName.SubForm)).Form
                ' Position subform at top record.
                wSubform.SelTop = 1
                Set rst = wSubform.RecordsetClone
                ' Find record for current key.
                ' Extract name of control on subform using Split:
                '   [ID]
                rst.FindFirst Split(aControls(wIndex), "!")(ControlName.Key) & " = " & wThisID
                If Not rst.NoMatch Then
                    bmk = rst.Bookmark
                    wSubform.Bookmark = bmk
                End If
                rst.Close
            End If
        Next

    End If

    Set rst = Nothing
    Set wSubform = Nothing

    SyncSubforms = wLastID

End Function

可在此下载完整演示: Sample Application Access 2010+