質問
質問者：kouziii EXCEL VBAでオートシェイプの重なりを検知するには？
困り度：
  • すぐに回答を！
 いつも拝見させていただいております。
教えてください。

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

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

簡単にできる方法がありましたら、お教え願います。
質問投稿日時：06/12/22 17:33
質問番号：2619138
この質問に対する回答は締め切られました。
最新から表示｜回答順に表示｜良回答のみ表示

回答

 
回答者：imogasi Left
.Top
.Height
.Width
で決まる長方形は、その中にシェイプが収まる四角形で、実際のシェイプの形とは、関係したものでは有りません。だからセルの場合はＩＮＴＥＲＳＥＣＴで判りますが、実際の図形の閉曲線輪郭が他の図形のそれと交わるか（共通点集合を持つかどうか）は、もう少し、細かいレベルのロジックやアルゴリズムによる、ビットをチェックする、アセンブラレベルのコーディングが要るのではないでしょうか。
（図形内を、色で塗りつぶしするロジックのような）
経験したような意見に書いてますが、体験したわけでなく、そういう道理だと思うわけです。
種類：アドバイス
どんな人：一般人
自信：参考意見
回答日時：06/12/22 22:17
回答番号：No.2
この回答へのお礼なるほど、よく分かりました。ありがとうございます。
重なりをチェックできるプロパティー値とかは、やっぱりないんですね。セルレベルの重なりチェックでできるかどうか検討してみます。INTERSECT知りませんでしたので助かりました。
ありがとうございました！

回答

良回答10pt
回答者：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
種類：アドバイス
どんな人：経験者
自信：参考意見
回答日時：06/12/22 18:34
回答番号：No.1
この回答へのお礼ありがとうございます。
自分なりに改良して、このコードを理解しました。
INTERSECTで出きるかちょっと検討してみます。
最新から表示｜回答順に表示｜良回答のみ表示
このページのトップへ