如何在MS Access表单中动态保持控件居中（相对位置）？

Question

我正在使用Access 2013工作，有一些控件（列表框、按钮等）需要在表单调整大小时保持居中。锚定无法实现我想要的效果，因为我不想将控件锁定在顶部/底部/左侧/右侧，而是希望它们保持在中心位置。在表单的调整大小事件上简单地使用像这样的代码me.mycontrol.left = myform.Width/2不能达到我想要的效果，因为它会将各个控件对齐到中心。我想让控件组保持居中，是否有方法可以实现呢？

编辑：这里有一个例子，可能会更清晰地说明问题。假设我有一个100 x 100的表单，上面有两个按钮。按钮高度为20个单位，间隔为10个单位。它们的位置如下：

Button1.Top = 25 (10个单位的空间从45开始) Button2.Top = 55

如果将表单调整为200 x 200，则控件的位置如下：

Button1.Top = 75 (10个单位的空间从95开始) Button2.top = 105

理想情况下，我希望将其转换为一个模块，只需传递一个表单，它就可以获取每个控件的原始位置并计算新位置。

编辑2：

这是一个失败的尝试，使用了我的真实代码，基于Krish的想法：

Private Sub Form_Resize()

Dim resizeFactor As Double

resizeFactor = Me.WindowWidth / Me.Width

Me.lstModule.Left = Me.lstModule.Left * resizeFactor
Me.ctlSubform.Left = Me.ctlSubform.Left * resizeFactor
Me.Box6.Left = Me.Box6.Left * resizeFactor

End Sub

- DataWriter

Answer 1

我认为锚定实际上就是答案。您只需在控件周围创建一个布局网格，并设置如下的锚定：

_____________________|___stretch down____|___________________
stretch across top___|___your controls___|stretch across top
_____________________|___stretch down____|___________________

这样，您的控件将始终停留在表单/子表单的中央。

编辑：屏幕截图

编辑：关于边框的信息

添加边框可能会比较麻烦，但在某种程度上是可能的。您可以通过设置网格线颜色，将按钮的网格线样式设置为实线（默认为透明），并添加一些填充来实现。在以下示例中，我将第一个按钮的网格线样式设置为LEFT、RIGHT和TOP的实线，并对这些侧面设置了0.1"的填充。如果您以类似的方式继续进行，您的结果将如下所示：

- Marek Stejskal

---

这是一个有趣的答案。自从我开始使用Office 2000以来，我从未尝试过使用布局。我会尝试一下并跟进与您联系。 - DataWriter

你好，DataWriter，它运行得很好。我曾经试过通过代码来处理这个问题，但我希望我没有那么做。感谢你的点赞，我的声望足够高，可以发布图片，所以我编辑了我的帖子，包含了概念证明的截图。 - Marek Stejskal

哇！这对按钮完美地运作。现在要尝试在更复杂的表单中使用它。感谢您的帮助。 - DataWriter

很高兴能够帮到你。即使是具有各种控件和子窗体的非常复杂的表单，它也可以正常工作。我使用了布局和锚定来创建一些非常好的自适应UI，没有使用VBA。只需注意，如果您添加/删除/合并某些单元格，则锚定有时会有重置的倾向，因此，如果定位突然停止工作，请在所有相关单元格中重新检查您的锚定设置。如果您实现了所需的功能，请跟进我，并将此答案标记为解决方案。 - Marek Stejskal

@PaulWilliams 是的，这些截图是来自2010版本。确保你处于表单设计模式下，然后你应该可以在功能区上看到一个排列选项卡。在那里，您可以选择堆叠或表格布局。 - Marek Stejskal

Answer 2

我可以使用元代码：

• 使用文本标记（“Tag”属性）标记组中的所有控件
• 遍历窗体上的所有控件，并为具有匹配标记的所有控件计算最左、最上、最右和最下位置（right=left+width等）
• 这是组“窗口”
• 现在再次遍历窗体，通过与组“窗口”相关的X/Y偏移量对控件进行偏移

或者，我想，一些真正的代码 :-)

    Public Function GetControlsWindowSize(tag As String)
    Dim f As Form
    Dim c As Control
    Dim GrpLeft As Long
    Dim GrpRight As Long
    Dim GrpTop As Long
    Dim GrpBottom As Long

        For Each c In f.Controls
            If c.Properties.Item("tag") = tag Then
                If GrpLeft = 0 Or GrpLeft > c.Left Then GrpLeft = c.Left
                If GrpRight = 0 Or GrpRight < c.Left + c.Width Then GrpRight = c.Left + c.Width
                If GrpTop = 0 Or GrpTop > c.Top Then GrpTop = c.Top
                If GrpBottom = 0 Or GrpBottom < c.Top + c.Height Then GrpBottom = c.Top + c.Height
            End If
        Next
    End Function

- Ben McIntyre

---

我喜欢这个，也尝试过，但是我在调整大小因子的公式上遇到了困难。你有什么想法吗？ - DataWriter

刚刚重新阅读了原始帖子。从你的描述中，控件尺寸将保持不变，左侧（顶部遵循相同的模式）应该是：mycontrol.left = myform.Width/2 - controlwindow.width/2 + (mycontrol.left - controlwindow.left)。 - Ben McIntyre

谢谢，我会尝试一下。 - DataWriter

添加了一些代码来计算窗口大小。在此之后，再次进行迭代并应用缩放因子。 - Ben McIntyre

Answer 3

我知道这已经晚了很多年，但是我有一个替代的VBA解决方案。在尝试了许多其他人的代码后，我写出了这个解决方案，但对它们的工作方式不满意。

我想要的是将所有控件都居中放置在表单内（弹出式表单）。但是我不希望它们全部挤在中心位置，我希望它们被“分组”，并且控件组在表单中心而不是每个单独的控件居中。

我需要满足的另一个条件是，当窗口最大化或缩小时，控件需要居中。随着用户调整表单大小，控件需要动态地居中在表单中。

我编写了一个子过程，需要在Private Sub Form_Resize()事件和Private Sub Form_Current()事件中调用。我正在使用Access 2010。

Private Sub Form_Resize()
'Should run every time the form is resized
    Call CenterControls
End Sub

而且

Private Sub Form_Current()
  'Will run when the form is completing its initialization
   DoCmd.Maximize   'Maximizes the form when first initialized. Omit if required.
   Call CenterControls
End Sub

这就是魔法发生的地方。

Sub CenterControls()

'Find the control that has the farthest left position, and the one with the farthest right position.
'That will give us the total distance of our buttons. We will then have to compare that to the width of the form, and move our controls accordingly.
Dim Ctrl As Control
Dim ClosestLeft As Integer
Dim FurthestRight As Integer
Dim FurthestRightWidth As Integer
Dim GrandTotalWidth As Integer
Dim AmountToMove As Integer
Dim TypicalPosition As Integer


'Finds the furthest left position of all of our controls on the form.
For Each Ctrl In Me
    If ClosestLeft > Ctrl.Left Or ClosestLeft = 0 Then
        ClosestLeft = Ctrl.Left
    End If

'Finds the furthest right control. Also takes the width of that furthest right control (necessary for the calculation)
    If FurthestRight < Ctrl.Left Or FurthestRight = 0 Then
        FurthestRight = Ctrl.Left
        FurthestRightWidth = Ctrl.Width
    End If
Next

'Now we find the grand total width of all of our controls. Furthest Right - Furthest Left + FurthestRightWidth
GrandTotalWidth = FurthestRight - ClosestLeft + FurthestRightWidth

'Finds the typical position of where the left side of the group of controls should sit on the form.
TypicalPosition = (Me.InsideWidth / 2) - (GrandTotalWidth / 2)

'Figures out the amount we'd have to move the group of controls to get them to sit in their typical position.
AmountToMove = TypicalPosition - ClosestLeft

For Each Ctrl In Me
    If Not ClosestLeft + AmountToMove <= 0 Then
        Ctrl.Left = Ctrl.Left + AmountToMove
    End If
Next


End Sub

现在当您运行弹出窗体时，所有控件应该作为一组居中于窗体。

- Thebaby

Answer 4

据我所知，在MS Access中没有任何布局“容器”（除了表格/堆叠视图）。您最好的选择是将字符串添加到组件的Tag属性中，并循环遍历需要重新对齐的组件。

类似这样的代码：

        Dim iCtl As control
        For Each iCtl In Me.Form
            If iCtl.Tag = "resize" Then
                On Error Resume Next
                Debug.Print "control resizing: " & iCtl.name
                iCtl.width = iCtl.width * resizeFactor
                iCtl.Height = iCtl.Height * resizeFactor
                'left top whatever you want to re align
            End If
        Next iCtl

- Krish

---

在阅读了您的答案后，我澄清了我的问题。看起来这种方法可能行得通。您知道我该如何计算resizeFactor吗？ - DataWriter

Answer 5

在Thebaby的优美方法、donohealy的补充和Ben McIntyre的标记的基础上，我能够想出这个模块函数。

主要区别:

1. 修复了一个小的数学问题，没有考虑到宽对象
2. 现在可以控制Y轴
3. 标记允许对移动进行精细控制（原始版本中的选项卡控件被破坏了）
4. 修复了用户在donohealy的帖子中提到的问题

缺点:

1. 仍然不是非常平滑
2. 列表框仍然很奇怪

公共函数 CenterControls(obj As Form, Centertag As String, Middletag As String)

'找到最左边位置的控件和最右边位置的控件。 '这将给我们按钮的总距离。然后，我们将必须将其与表单的宽度进行比较，并相应地移动我们的控件。 Dim Ctrl As Control Dim ClosestLeft As Integer Dim FurthestRight As Integer Dim GrandTotalWidth As Integer Dim AmountToMoveLR As Integer Dim TypicalPositionLR As Integer Dim ClosestTop As Integer Dim FurthestDown As Integer Dim GrandTotalHeight As Integer Dim AmountToMoveTB As Integer Dim TypicalPositionTB As Integer Dim StopLR As Boolean Dim StopTB As Boolean

'找到所有控件中最左边的位置。 For Each Ctrl In obj If (Ctrl.Properties.Item("tag") = Centertag) Then If ClosestLeft > Ctrl.Left Or ClosestLeft = 0 Then ClosestLeft = Ctrl.Left End If '找到最右边的控件。还需要该最右边控件的宽度（计算所必需） If FurthestRight Ctrl.Top Or ClosestTop = 0 Then ClosestTop = Ctrl.Top End If '找到最低下的控件。还需要该最低下控件的高度（计算所必需） If FurthestDown = obj.InsideWidth Then StopLR = True If (ClosestLeft + AmountToMoveLR) = obj.InsideHeight) Then StopTB = True If (ClosestTop + AmountToMoveTB

- Doomoocloo

Answer 6

Thebaby 提交的答案是一个优雅的解决方案 - 我试过几个。我在 Windows 10 上运行 Access 16。

我建议将 Sub CenterControls() 放在一个模块中作为公共函数，并从每个使用它的表单的 Form_Resize() 和 Form_Current() 中调用它。

作为公共函数，您需要将所有对 Me 的引用替换为 screen.activeform 和相关属性。

例如： For Each Ctrl In Me For Each Ctrl In screen.activeform.controls

或者

TypicalPosition = (Me.InsideWidth / 2) - (GrandTotalWidth / 2) 需要更新为：TypicalPosition = (screen.activeform.InsideWidth / 2) - (GrandTotalWidth / 2)

- donohealy

---

我在Access 365上使用了上面的代码，并且在最后一行出现错误： Ctrl.Left = Ctrl.Left + AmountToMove - user2718740