マクロで前面の画像削除

エクセルで重なっている画像の最前面の画像のみを削除したいのですが、マクロで処理できますか？
重なっている画像は複数あって、その全ての最前面に表示されている画像を削除したいです。
宜しくお願いします。

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

• すみません説明不足で・・・
  画像は重なっていないものもあれば、重なっているものもバラバラであります。
  重なっている時は、2つの画像が重なっていて、3つ以上の重なりはありません。
  画像が重なっていないものは、削除しないで欲しいです！
  難しくてすみません。

  No.1の回答に寄せられた補足コメントです。 補足日時：2017/10/27 14:37

• はい、画像が貼り付けられたセルを基準に重なっているかの判断でお願いします。
  イメージとしては四角い画像の上に小さい画像が重なっている感じです。
  カタログの様に複数規則正しく表示されています。

  No.4の回答に寄せられた補足コメントです。 補足日時：2017/10/27 15:18

• はい③と④の重なりは無いです。
  ①の上に小さい画像で②が重なっています。

  No.5の回答に寄せられた補足コメントです。 補足日時：2017/10/27 15:33

No.7 ベストアンサー 回答者： GooUserラック 回答日時： 2017/10/27 17:21

いくつか画像が重なっていた場合、一番下の画像のみ残すものです。

3つ以上の重なりは無いとの事なので問題はないかと…
-----------------------------------------------------------------------------------------
Sub Sample()
Dim 辞書 As Variant
Dim 番号 As Long
Dim 位置 As String
Set 辞書 = CreateObject("Scripting.Dictionary")
番号 = 1
Do While 番号 <= ActiveSheet.Shapes.Count
位置 = ActiveSheet.Shapes(番号).TopLeftCell.Address
If 辞書.Exists(位置) Then
ActiveSheet.Shapes(番号).Delete
Else
辞書.Add 位置, 位置
番号 = 番号 + 1
End If
Loop
Set 辞書 = Nothing
End Sub
-----------------------------------------------------------------------------------------

この回答へのお礼

凄いです！思っている事が出来ました！
何回も答えていただきありがとうございました！

お礼日時：2017/10/27 17:39

No.8 回答者： GooUserラック 回答日時： 2017/10/27 17:34

No.7 の説明をしておきます。

「ActiveSheet.Shapes.Count」で図形に振られてる最後の番号を得られます。
「ActiveSheet.Shapes(番号)」の図形に振られる番号は、最後部から振られていく、もちろん順番を入れ替えればこの番号も変わる。
最後部から辞書にセルの位置を登録していきます。もし、すでに辞書に登録されていたら削除します。削除するとそれ以降の番号も１減るので、番号を変えなければつぎを確認できます。これを最後の番号まで繰り返します。

もし判らないところが有ったら聞いてください。

No.6 回答者： WindFaller 回答日時： 2017/10/27 17:15

少し考えてみました。

ちょうど、#2の画像が最適でしたので説明されていただきますが、
最初、二つの画像で比較していたものを、Union でもとめて、その中から選ぶようにしました。
まだ、おかしな所があるのかもしれません。

'//
Sub TestShpDel()
　Dim Rng2 As Range, RngU As Range
　Dim a As Range, b As Range, c As Range, d As Range
　Dim i As Long, j As Long, k As Long, m As Long, max As Long
　Dim Colshp As Collection
　Set Colshp = New Collection
　With ActiveSheet
　 .Range("A1").Select　'誤動作を防ぐため
　　j = 1
　　For i = 1 To .Shapes.Count
　　　If TypeName(.Shapes(i).DrawingObject) = "Picture" Then
　　　　 Colshp.Add .Shapes(j)
　　　End If
　　　j = j + 1
　　Next
　　j = 0
　　For i = 1 To Colshp.Count - 1
　　　Set a = Colshp(i).TopLeftCell
　　　Set b = Colshp(i).BottomRightCell
　　　If Not RngU Is Nothing Then
　　　　 Set RngU = Union(RngU, RngU)
　　　Else
　　　　Set RngU = Range(a, b)
　　　End If
　　　For j = i + 1 To Colshp.Count
　　　　Set c = Colshp(j).TopLeftCell
　　　　Set d = Colshp(j).BottomRightCell
　　　　Set Rng2 = Range(c, d)
　　　　If Not Intersect(RngU, Rng2) Is Nothing Then
　　　　　Set RngU = Union(RngU, Rng2)
　　　　　m = Colshp(i).ZOrderPosition
　　　　　k = Colshp(j).ZOrderPosition
　　　　　If k > m Then
　　　　　　If max < k And k > 1 Then
　　　　　　　max = j
　　　　　　End If
　　　　　End If
　　　　End If
　　　Next
　　　If max > 1 Then
　　　　Colshp(max).Select False
　　　End If
　　　max = 0
　　　Set RngU = Nothing
　　Next
　End With
　If TypeName(Selection) = "DrawingObjects" Or TypeName(Selection) = "Picture" Then
　If MsgBox("削除してよろしいですか？", vbOKCancel) = vbCancel Then Exit Sub
　　Selection.Delete
　Else
　　MsgBox "削除対象が見つかりません。", vbExclamation
　End If
End Sub
'//

画像では、1と4が削除対象になります。
ただ、画像の見えない範囲が、誤動作を産む可能性があります。

この回答へのお礼

有難うございます。テストしてみます。

お礼日時：2017/10/27 17:39

No.5 回答者： GooUserラック 回答日時： 2017/10/27 15:26

No.4 に対する補足コメントについて

一応念のために確認ですが、下図のような①と②のようなものは有るが、③と④のようなものは無いと考えて良いのでしょうか？

No.4 回答者： GooUserラック 回答日時： 2017/10/27 14:57

No.1 に対する補足コメントについて

画像が貼り付けられたセル（画像の左上が有るセル）を基準に重なっているかを判断すれば良いのでしょうか？

No.3 回答者： GooUserラック 回答日時： 2017/10/27 14:49

No.2 の追補（１つの回答に図を１つしか載せられないので）

下図のように人間が見た目重なっていない場合はどうするのでしょうか？
ちなみにどちらが最前列になっているか判りますか？

No.2 回答者： GooUserラック 回答日時： 2017/10/27 14:41

全部が同じところに重なっているなら簡単に出来ますが、グループ化されていない状態でバラバラに配置されているならばほぼ無理です。

（どれとどれが重なっているかの判断が難しいので…）
例えば、下図のような場合はどうするのでしょうか？

No.1 回答者： fujillin 回答日時： 2017/10/27 13:56

こんにちは

ご質問文だけだと、いろいろなケースが想定されるので、具体的な処理内容は決められないように思います。


単純に、シート内の最前面にある画像を削除すればよいだけなら、以下によるとインデックスが最大の画像を削除すればよさそうです。
https://msdn.microsoft.com/ja-jp/VBA/Excel-VBA/a …
（重なりがあろうがなかろうが、最前面の画像が削除されるでしょう）

重なっていることを前提とする場合は、
指定された画像と重なっている画像の中から最前面のものを削除するのなら、画像を指定し、それと重なっているものをチェックして、その中で最前面のものを削除するという処理になるでしょう。
あるいは、画像を指定せずにシート内で重なりあう関係にある画像を全て探し（複数個所に点在する場合もあり得る）、それぞれの最前面のものを削除するとか。（このケースでは、一度に複数の画像が削除されることがある）

一方で、重なりを判定するのにも、各画像の四隅の矩形で判断してよいのか、画像の実態で判断しなければいけないのかでも考え方はまったく異なるものになるでしょう。
「画像」が写真などの場合であれば矩形の判定で済みそうですが、画像の実態で重なりをチェックしなければならないとなると、相当に難しい処理になるものと予想されます。
（可能なのか不明です）

重なっているか否かの判断に関しても、図形AとB、図形BとCが重なっている状態で、図形AとCは直接には重なっていないような場合に、AとCは重なっているとみなすのかどうかといった点についても考え方は様々と言えるでしょう。