EXCEL VBAでオートシェイプの重なりを検知するには？

質問

いつも拝見させていただいております。
教えてください。

excelのバージョンは2002です。
ひとつのオートシェイプに他のオートシェイプが重なっていた場合、重なっているオートシェイプを移動し、重ならないようにしたいのですが、どうやればよいでしょうか？

Shapeオブジェクトの
.Left
.Top
.Height
.Width
を駆使してチェックするしかないでしょうか？

簡単にできる方法がありましたら、お教え願います。

回答No.2

imogasi

Left
.Top
.Height
.Width
で決まる長方形は、その中にシェイプが収まる四角形で、実際のシェイプの形とは、関係したものでは有りません。だからセルの場合はＩＮＴＥＲＳＥＣＴで判りますが、実際の図形の閉曲線輪郭が他の図形のそれと交わるか（共通点集合を持つかどうか）は、もう少し、細かいレベルのロジックやアルゴリズムによる、ビットをチェックする、アセンブラレベルのコーディングが要るのではないでしょうか。
（図形内を、色で塗りつぶしするロジックのような）
経験したような意見に書いてますが、体験したわけでなく、そういう道理だと思うわけです。

お礼

なるほど、よく分かりました。ありがとうございます。
重なりをチェックできるプロパティー値とかは、やっぱりないんですね。セルレベルの重なりチェックでできるかどうか検討してみます。INTERSECT知りませんでしたので助かりました。
ありがとうございました！

回答No.1

Wendy02

こんばんは。

今、思いつくのは、以下のように、Rangeオブジェクトをとる方法ですね。

　With ActiveSheet.Shapes(1)
　Set shp = Range(.TopLeftCell, .BottomRightCell)
　End With

これで、Rangeオブジェクトが取れますから、それを、Intersect を使って、二重ループでまわしたらいかがですか？あまり深く考えていないので、間違っているかもしれません。

簡単な例を考えてみました。

Sub CheckDoubleTest()
　Dim ShpR1 As Range
　Dim ShpR2 As Range
　Dim i As Integer
　Dim j As Integer
　With ActiveSheet
　　For i = 1 To .Shapes.Count
　　　Set ShpR1 = .Range(.Shapes(i).TopLeftCell, .Shapes(i).BottomRightCell)
　　　For j = i + 1 To .Shapes.Count
　　　　If i <> j Then
　　　　　Set ShpR2 = .Range(.Shapes(j).TopLeftCell, .Shapes(j).BottomRightCell)
　　　　　If Not Intersect(ShpR1, ShpR2) Is Nothing Then
　　　　　　'処理
　　　　　End If
　　　　End If
　　　Next j
　　Next i
　End With
Set ShpR1 = Nothing: Set ShpR2 = Nothing
End Sub

お礼

ありがとうございます。
自分なりに改良して、このコードを理解しました。
INTERSECTで出きるかちょっと検討してみます。