Question

我正在使用代码根据使用VBA的用户输入在Excel中绘制多个AutoShapes。然而，这些形状中的一些可能会相互遮挡，所以我想运行第二遍来测试哪些形状遮挡并轻推它们直到它们不再遮挡。

所以基本的伪代码大纲是：

do
    foreach shape s in shapes
        if (s.hittest(shapes)) then
            do
                s.nudgeup(1)
            until (!s.hittest(shapes))
        endif
    next
until (!shapes.hittest(shapes))

你们有没有想过这样做的某种方式（甚至可以解决这个问题，所以不必这样做）？

我已经看了一下RangeFrom函数，但这看起来并不多用（只在特定的屏幕坐标处返回一个形状，而不是相交的形状）。

非常感谢你的帮助。

Answer 1

您可以执行以下操作：

Sub MoveShapes()
    Dim wb As Workbook
    Set wb = ActiveWorkbook
    Dim sh As Worksheet
    Set sh = wb.ActiveSheet
    Dim s1 As Shape
    Dim s2 As Shape

    For i = 1 To sh.Shapes.Count
        If i < sh.Shapes.Count Then
            Set s1 = sh.Shapes(i)
            Set s2 = sh.Shapes(i + 1)
            If s2.Left < (s1.Left + s1.Width) Then
                s2.Left = (s1.Left + s1.Width + 1)
            End If
        End If
    Next
End Sub

此代码需要更多工作才能考虑到顶部/底部和多个重叠，但这应该足以让您入手。

命中测试并解决Excel中AutoShapes的遮挡问题

1 个答案: