MS Access vba中的分组字段

Posted 2023-04-19

【中文标题】MS Access vba中的分组字段

【英文标题】：Grouping fields in MS Access vba

【发布时间】：2020-02-21 16:21:34

【问题描述】：

有没有办法在 MS Access 表单中对字段进行分组？我正在使用 vba 根据标准移动表单中的各个字段。有没有办法将一些字段放在某种框内并移动该框，而不是一次移动一个控件？

【问题讨论】：

我不知道。您可以设置它们的 Tag 属性以轻松识别它们，仅此而已。

是的，标记或使用通用前缀作为他们的名字。 If ctl.Name Like "foobar*" Then。在某些情况下，子表单可能是可能的，但这可能太具有侵入性了。

如果我只是想隐藏和取消隐藏一堆控件，这将很有帮助。我正在尝试移动它们。当我只有 5-10 时，我正在将每个控件的英寸转换为缇，并执行以下操作：Me.lblTest.Move Left:=180, Top:=3359.95

但是如果我可以使用像组框这样的东西，那么我只需要设置一堆组框的位置，这会容易得多

【参考方案1】：

如果您将要移动的控件放入集合中（例如，通过使用.Tag或.Nameproperty），只需遍历该集合（您的组）并将每个控件移动相同的值。

在标准模块中：

Public Sub MoveGroup(ByVal MovingGroup As Collection, _
                     ByVal AddLeft As Long, _
                     ByVal AddTop As Long)

    Dim CtlToMove As Control
    For Each CtlToMove In MovingGroup
        CtlToMove.Move CtlToMove.Left + AddLeft, CtlToMove.Top + AddTop
    Next
End Sub

Public Sub MoveByTagAsolute(ByRef CtlAbsolute As Control, _
                            ByVal MovingGroupTag As String, _
                            ByVal NewLeft As Long, _
                            ByVal NewTop As Long)

    Dim CtlGroup As Collection
    Set CtlGroup = New Collection
    Dim CtlToMove As Control
    For Each CtlToMove In CtlAbsolute.Parent.Controls
        If CtlToMove.Tag Like MovingGroupTag Then
            CtlGroup.Add CtlToMove
        End If
    Next
    MoveGroup CtlGroup, NewLeft - CtlAbsolute.Left, NewTop - CtlAbsolute.Top
End Sub

Public Sub MoveByTagRelative(ByRef Frm As Form, _
                             ByVal MovingGroupTag As String, _
                             ByVal AddLeft As Long, _
                             ByVal AddTop As Long)

    Dim CtlGroup As Collection
    Set CtlGroup = New Collection
    Dim CtlToMove As Control
    For Each CtlToMove In Frm.Controls
        If CtlToMove.Tag Like MovingGroupTag Then
            CtlGroup.Add CtlToMove
        End If
    Next
    MoveGroup CtlGroup, AddLeft, AddTop
End Sub

在表单模块中：

Private Sub CommandMoveByTagAsolute_Click()
    MoveByTagAsolute Me.Controls("ControlAbsolutePos"), "move*", 2000, 3000
End Sub

Private Sub CommandMoveByTagRelative_Click()
    MoveByTagRelative Me, "*", 1000, 2000
End Sub

ButtonCommandMoveByTagAsoluteclick-event 移动ControlAbsolutePos到新坐标，其余组相对于它移动。

ButtonCommandMoveByTagRelativeclick-event 相对移动整个组（“*”选择表单上的所有控件）。