在Excel中对自选图形进行命中测试和解决遮挡

问题描述

我正在使用代码根据使用VBA的用户输入在Excel中绘制许多自选图形.但是，其中某些形状可能会相互遮挡，因此我想进行第二次通过以进行测试以测试哪些形状遮挡并轻推它们，直到它们不再遮挡为止.

I am using code to draw a number of AutoShapes in Excel based on user input using VBA. However, some of these shapes may occlude each other, so I would like to run a second pass to hit-test which shapes occlude and to nudge them until they no longer occlude.

因此基本的伪代码大纲为:

So the basic pseudocode outline would be:

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))

你们中的任何人都可以想到一些实现此目的的方法(甚至可以解决此问题，因此不必这样做)吗?

Can any of you think of some way of doing this (or even working around this so this doesn't have to be done)?

我看过RangeFrom函数，但这似乎没什么用(仅在特定的屏幕坐标处返回一个形状，而不是相交的形状).

I've taken a look at the RangeFrom function, but that doesn't seem to be much use (only returns one shape at a specific screen coordinate, not intersecting shapes).

非常感谢您的帮助.

推荐答案

您可以执行以下操作:

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

此代码需要做更多的工作才能解决顶部/底部和多个重叠的问题，但这应该足以使您入门.

This code would need more work however to account for top/bottom and multiple overlaps, but this should be enough to get you start.

这篇关于在Excel中对自选图形进行命中测试和解决遮挡的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持！