VBAによる図形位置判定

VBAにて図形の位置判定ができないかどうか考えております。
ある図形が指定範囲の指定位置にあれば引っかかるようなVBAを作成したいです。

添付Excelのような図があります。
この図形に対して、表の上、表の下、裏の上、裏の下の4つのゾーンがあり、
①及び②が合っているかどうかを判定したいです。
For Each sp In ActiveSheet.Shapes
If Not Intersect(Range(sp.TopLeftCell, sp.BottomRightCell), ws) Is Nothing Then
で判定させようかと思いましたが、①と②それぞれで全図形を回ってしまうので、
①の●が表の上というのは合っていますが、▲が表の下にあるため引っかかってしまいます。
その逆もしかりで、②の▲が表の下は合っていますが、●が上にあるため引っかかってしまいます。

For Nextで回る図形をセルの値などから指定範囲内のみで回るようになどできないものでしょうか。
例えば、この画像で言えば、①の場合は表の上の図形のみFor Nextするといった具合です。

どのように伝えればいいか難しく、分かりにくい質問ではあるかと存じますがよろしくお願い致します。

質問者からの補足コメント

• 記載を忘れておりましたが、Shapeの形は複数あり、かつ、どれが使用されるかは決まっておりません。
  また、本質問では分かりやすくするため①●、②▲としておりますが、実際にはここにも文字が入ります。
  重要な情報の記載を忘れ後出しとなってしまい申し訳ありません。

  No.1の回答に寄せられた補足コメントです。 補足日時：2022/03/08 17:27

• ご回答ありがとうございます。
  wsは上を表す変数ですので、質問文のコードはActiveSheet内のShapeをループし、範囲ws(上)に図形がある場合に処理される
  といったコードで合っていますよね？(VBAについてあまり知識がないので、為念確認させてください）
  上記解釈であれば、そもそもActiveSheetのShapeをループするのではなく、範囲ws内のShapeのみループの対象にできないかというのが質問となります。
  
  図の長方形からはみ出す場合もありますので、範囲は現行のままで行きたいと思います。

  No.3の回答に寄せられた補足コメントです。 補足日時：2022/03/09 08:50

• ご回答ありがとうございます。
  
  自分でもどのように言語化すればよいかが難しく、ご回答者様にはご不便をかけます。
  wsは上を表しています。
  
  「表上」などのそれぞれの範囲でチェックすれば良いのでは？
  →ActiveSheet上のShapeではなく、表上などのそれぞれの範囲内のShapeをループしてチェックということでしょうか。
  もしよろしければ、どのようなコードとなるかご教示いただけますでしょうか。
  
  ●や▲は不良を表しております。Shapeで区別しようにも異なる不良に対して同じShapeが使われることがしばしばあるので、せっかく教えていただきましたが難しいかと。。

  No.4の回答に寄せられた補足コメントです。 補足日時：2022/03/09 08:56

• 

  Shapeが範囲内にあればというよりも範囲内になければ処理をしたいのですが、範囲外には対象のShape以外のShapeがあるため、If Not Intersect を If Intersectにすると、対象外の範囲外Shapeまで処理されてしまいます。

    補足日時：2022/03/09 11:20

• やはりできないのですね。
  
  ご教示いただいたsampleコードのRangeを運用Rangeである
  Set Rng1 = Range("B35:G43")
  Set Rng2 = Range("B35:L38")
  に変えて動作させたところ、何度かループが回ったのちに
  Set shpRng = Range～
  のところで1004エラーが返されてしまいました。

  No.8の回答に寄せられた補足コメントです。 補足日時：2022/03/09 15:05

• 

  No.8様
  
  先ほど補足で1004エラーが返されると書きましたが、再度実行するとエラー発生しませんでした。
  複数範囲指定が最も創造に近い動きをしています。
  ありがとうございます。
  
  少し詰めてみて、再度問題点がでてくれば補足もしくは新しい質問にて質問させていただいてもよろしいでしょうか。

    補足日時：2022/03/09 15:16

No.9 回答者： Qchan1962 回答日時： 2022/03/10 14:58

こんにちは

解決への糸口が見つかったようで何よりです。
＞少し詰めてみて、再度問題点がでてくれば補足もしくは新しい質問にて質問させていただいてもよろしいでしょうか。

このご質問に補足されても多くの方が見る可能性は低くなると思いますし
本質問と違う部分であれば、マナー的にも問題がありますので
新しいご質問を建てるのが良いと思います

No.8 回答者： Qchan1962 回答日時： 2022/03/09 14:23

連続投稿すみません

＞ActiveSheetのShapeをループするのではなく、範囲ws内のShapeのみ
＞ループの対象にできないかというのが質問となります。

これに回答していませんでした
残念ながら出来ないと思います。
例えば、 For Each sp In ActiveSheet.Range("A1:I20").Shapes
ShapeはRangeに属していない為　438エラーになります

従って、ActiveSheet.Shapesのコレクションをループして
配置されている場所、TopLeftCellなどを取得して比較する必要があります。
場所とは関係ありませんが、タイプや名前などで限定する事は出来ます
（＃６回答）しかし、コード内で名前の配列などを作成するのであれば、
その場所で（サブルーチンを含め）メイン処理を行っても同じことになります。
予めセルなどに名前が入力されているのなら、すべてのShapeをループする必要はありませんが、If分岐するので数百、数千Shapeが無いのであれば
For Each sp In ActiveSheet.Shapesで問題ないと思います。

No.7 回答者： Qchan1962 回答日時： 2022/03/09 13:59

＃６です

複数範囲を設定しても
こんな感じ、、、
Sub sample()
Dim Rng1 As Range, Rng2 As Range
Dim shpRng As Range
Dim sp As Shape
Set Rng1 = Range("C3:I20") 'グループ1
Set Rng2 = Range("C10:I20") 'グループ2
For Each sp In ActiveSheet.Shapes
Set shpRng = Range(sp.TopLeftCell, sp.BottomRightCell)
If Not Intersect(shpRng, Rng1) Is Nothing Then
If Intersect(shpRng, Rng2) Is Nothing Then
Debug.Print "グループ1"; shpRng.Address(0, 0); "=="; sp.Name
Else
Debug.Print "グループ2"; shpRng.Address(0, 0); "=="; sp.Name
End If
Else
Debug.Print "グループ以外"; shpRng.Address(0, 0); "=="; sp.Name
End If
Next
End Sub

No.6 回答者： Qchan1962 回答日時： 2022/03/09 13:27

こんにちは、

＞対象外の範囲外Shapeまで処理されてしまいます。
複数範囲を設定しても範囲で分けられないと言う事でしょうか？

現状のシートにあるShapesを確認して
Nameで指定してループ処理をするのが良いのかな・・と思います

一度でも範囲に入ったら登録するとか、色々考えられますが、
取敢えず、名前が判れば良いかな。

シート上にあるShapeの名前とインデックス（グループや重なりの場合Indexでは無いけれど）

イミディエイトウィンドウの使い方、わかりますか？分かるとして
Sub chk()
Dim sp As Variant
For Each sp In ActiveSheet.Shapes
sp.Select
Debug.Print sp.ZOrderPosition; "name="; sp.Name
Stop
Next
End Sub
シート上のすべてのShapeのZOrderPositionと名前がイミディエイトウィンドウに出力されます。
Stopで1つ１つ止まるのでその時の選択されているShapeの情報です
StopはF5キーで進めてください。

名前で限定処理をする方法（例：名前"Rectangle 2", "Oval 1"のShapeに対して）
Sub 限定Shape()
Dim shpN As Variant
For Each shpN In Array("Rectangle 2", "Oval 1")
With ActiveSheet.Shapes(shpN)
.Select
Stop
End With
Next
End Sub
対象のShapeが選択されます
Stopはデバッグ用なので実際には必要ありません。

No.5 回答者： fujillin 回答日時： 2022/03/09 11:33

No4です。

＞Shapeが範囲内にあればというよりも範囲内になければ処理をしたい
＞のですが、範囲外には対象のShape以外のShapeがあるため、
＞If Not Intersect を If Intersectにすると、対象外の範囲外Shape
＞まで処理されてしまいます。

当然の結果です。
冷静に再度なさりたいことを整理して考えてみれば、ご自身で解決できるのでは？

そのままの文章情報からだけでは、誰も解読できません。
文章の雰囲気からすると「範囲内にあるもののうち、範囲外のShapeを処理したい」と読めますが、それは「存在しないものを処理したい」という意味になります。

No.4 回答者： fujillin 回答日時： 2022/03/08 18:30

こんばんは

不明点が多すぎるので、とてもコードにはできませんけれど・・・

変数wsが何を示しているのか不明ですが、「表上」などのそれぞれの範囲でチェックすれば良いのでは？
また、①●、②▲が変わるということなので、Shapeの方も区別して、判別対称でないものはスキップしてチェックすれば、それですみそうですけれど・・・

「どのShapeが●なのか▲なのかわからない」というのであれば、まずはそこからチェックする必要がありそうですね。
オートシェイプを利用しているのなら、Shape.AutoShapeType で種類を調べることは可能です。
https://docs.microsoft.com/ja-jp/office/vba/api/ …

No.3 回答者： Qchan1962 回答日時： 2022/03/08 18:19

こんばんは、

ご質問を読み違えているかも知れませんが、
＞①の場合は表の上の図形のみFor Nextするといった具合です。
wsに問題があるのでは？確かにループはActiveSheet上のすべてのShapeが対象になるけれど条件内の処理は範囲内にあるShapeのみと思います。

If Not Intersect(Range(sp.TopLeftCell, sp.BottomRightCell), ws) Is Nothing Then
ws はシート？　これをセル範囲にする必要があると思います。

少しでもかかっていれば対象にするのであれば、良いと思いますが
Range(sp.TopLeftCell, sp.BottomRightCell　これは範囲になると思いますので範囲から出さないようにするにはtop と bottomを分けて条件にするとかでしょうか

特定Shapeを指定する場合は、既存図形を表す Shapes(index) を使えば限定出来ます
indexはインデックス番号ですが、図形名(Name)でも特定できます。

No.2 回答者： mygoonickname 回答日時： 2022/03/08 17:35

No.1の者です。

セルの範囲内の図形を処理するという事でしょうか？
検索した記事ですが、下記が参考になるでしょうか？

https://www.limecode.jp/entry/tools/shapes-selec …

No.1 回答者： mygoonickname 回答日時： 2022/03/08 17:11

こんばんは。

Shapesで、●と▲でしたら、nameで●or▲の図形かを判別すれば良いの
では？と思いますが。