Hit-Testing and Resolving Occlusion of AutoShapes in 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)?

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

Many thanks for your help.

回答1:

You could do something like the below:

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.

来源：https://stackoverflow.com/questions/5158128/hit-testing-and-resolving-occlusion-of-autoshapes-in-excel