概要
Excelで作業をしていると、意図せず画像が重なってしまったり、複数の画像が配置されてしまい、どれがどれだか分からなくなってしまうことがあります。一つ一つ手動で選択して削除するのは非常に手間がかかり、特に大量の画像がある場合には膨大な時間がかかってしまいます。この問題に対し、VBA（Visual Basic for Applications）を活用することで、重なり合った画像を自動的に検出し、削除することが可能です。本稿では、「VBA100本ノック」シリーズの90本目として、この「セルに重なっている画像の削除」に焦点を当て、その具体的な実装方法と、作業効率を劇的に向上させるためのVBAコードを解説します。
詳細解説
Excelにおける画像オブジェクトは、Shapeオブジェクトとして扱われます。Shapeオブジェクトには、その位置、サイズ、種類など、様々なプロパティがありますが、今回注目するのは、画像が重なっているかどうかを判定するロジックです。
画像が重なっているかどうかを判断するには、各画像オブジェクトのLeft, Top, Width, Heightプロパティを取得し、それらの座標とサイズを比較します。具体的には、ある画像Aと別の画像Bがあった場合、以下の条件のいずれかが満たされると、画像Aと画像Bは重なっていると判断できます。
* 画像Aの左端が画像Bの右端より左にあり、かつ画像Aの右端が画像Bの左端より右にある。
* 画像Aの上端が画像Bの下端より上にあり、かつ画像Aの下端が画像Bの上端より下にある。
しかし、すべての画像ペアに対してこの比較を行うのは計算量が多く、非効率的です。より現実的なアプローチとしては、以下の手順で処理を進めます。
1. **対象シートの全画像オブジェクトを取得する。**
2. **各画像オブジェクトを順番に処理する。**
3. **現在処理中の画像オブジェクトと、それ以降に配置されている画像オブジェクトを比較する。**
4. **重なっている画像オブジェクトを特定する。**
5. **重なっていると判断された画像オブジェクトを削除する。**
ここで重要なのは、「重なっていると判断された画像オブジェクトを削除する」という部分です。どの画像を削除するかは、要件によって異なります。例えば、「後から配置された画像を削除する」、「より小さい画像を削除する」、「指定した条件に合致しない画像を削除する」など、様々なケースが考えられます。
本稿で紹介するサンプルコードでは、シンプルに「後から配置された（つまり、ループ処理で後に出てきた）重なっている画像を削除する」というロジックを採用します。これは、Excelの標準的な操作で画像を追加していくと、後から追加した画像が前面に来ることが多いため、直感的で分かりやすいからです。
より高度な処理としては、画像の位置情報だけでなく、画像の種類（JPEG, PNGなど）や、画像に付随するファイル名、あるいは画像が配置されているセル範囲などを考慮して、削除対象を絞り込むことも可能です。例えば、特定のシートや特定のセル範囲に重なっている画像のみを対象とする、といった制御もVBAを使えば容易に実現できます。
また、画像が重なっているかどうかを判定する際に、完全な重なりだけでなく、わずかな重なりも検出したい場合があります。その場合は、座標の比較に許容誤差（epsilon）を設けるなどの工夫が必要になります。
さらに、大量の画像を処理する場合、パフォーマンスを考慮する必要があります。すべての画像ペアを比較するのではなく、画像の位置情報を元にグリッドを作成し、各グリッドに存在する画像を比較対象とするなどの最適化手法も考えられます。しかし、一般的なExcelの利用シーンにおいては、今回紹介する比較的シンプルなロジックでも十分な効果が得られるでしょう。
サンプルコード
以下のVBAコードは、アクティブシート上に配置されている画像のうち、互いに重なっている画像を検出し、後から配置された（ループで後に出てきた）画像を削除するものです。
Sub DeleteOverlappingImages()
Dim ws As Worksheet
Dim sh1 As Shape
Dim sh2 As Shape
Dim shapesToDelete As Collection
Dim shapeName As Variant
‘ 現在アクティブなシートを対象とする
Set ws = ActiveSheet
‘ 削除対象のShapeオブジェクトを格納するコレクションを初期化
Set shapesToDelete = New Collection
‘ シート上のすべてのShapeオブジェクトをループ処理
‘ For Each…Next はオブジェクトの追加・削除によって予期せぬ動作をする可能性があるため、
‘ インデックスを使ったFor…Nextループで処理します。
‘ ただし、Shapeオブジェクトはインデックスが固定ではないため、
‘ 実際にはプロパティを元に比較する方が堅牢です。
‘ ここでは、より直感的な比較のために、一旦すべてのShapeを配列に取り出してから処理します。
Dim shapeArray() As Shape
Dim i As Long, j As Long
Dim numShapes As Long
‘ シート上のShapeオブジェクトの数を取得
numShapes = ws.Shapes.Count
‘ Shapeオブジェクトを配列に格納
ReDim shapeArray(1 To numShapes)
i = 1
For Each sh1 In ws.Shapes
shapeArray(i) = sh1
i = i + 1
Next sh1
‘ 各Shapeオブジェクトを比較し、重なっているものを検出
‘ 外側のループで現在のShape（sh1）、内側のループで比較対象のShape（sh2）
For i = 1 To numShapes
Set sh1 = shapeArray(i)
‘ 既に削除対象としてマークされているShapeはスキップ
On Error Resume Next ‘ Collection.Remove が失敗した場合のエラーを無視
shapesToDelete.Add sh1, sh1.Name ‘ 追加を試み、失敗すれば既に存在すると判断
On Error GoTo 0
If shapesToDelete.Count > 0 And Err.Number <> 0 Then
‘ 既に削除対象なのでスキップ
Err.Clear
GoTo SkipShape
End If
On Error GoTo 0 ‘ エラーハンドリングをリセット
For j = i + 1 To numShapes ‘ 自分自身との比較や、既に処理済みのShapeとの重複比較を避ける
Set sh2 = shapeArray(j)
‘ 削除対象としてマークされているShapeはスキップ
On Error Resume Next
shapesToDelete.Add sh2, sh2.Name
On Error GoTo 0
If shapesToDelete.Count > 0 And Err.Number <> 0 Then
Err.Clear
GoTo SkipShape2
End If
On Error GoTo 0
‘ 重なっているかどうかの判定
‘ 2つのShapeが重なっている条件:
‘ Shape1の右端 > Shape2の左端 かつ Shape1の左端 < Shape2の右端
' かつ
' Shape1の下端 > Shape2の上端 かつ Shape1の上端 < Shape2の下端
If Not sh1.Top >= sh2.Top + sh2.Height Or _
Not sh1.Top + sh1.Height <= sh2.Top Or _
Not sh1.Left >= sh2.Left + sh2.Width Or _
Not sh1.Left + sh1.Width <= sh2.Left Then
' 重なっていると判断された場合、後から出てきた方（sh2）を削除対象に追加
' Collectionに同じ名前のShapeが複数追加されるのを防ぐため、
' 削除対象リストに既に存在するか確認してから追加します。
On Error Resume Next
shapesToDelete.Add sh2, sh2.Name
If Err.Number <> 0 Then
‘ 既に削除対象リストに追加されている場合は何もしない
Err.Clear
End If
On Error GoTo 0
End If
SkipShape2:
Next j
SkipShape:
Next i
‘ 削除対象リストにあるShapeを実際に削除
If shapesToDelete.Count > 0 Then
For Each shapeName In shapesToDelete
‘ CollectionからShapeNameを取り出すのは直接できないため、
‘ NameプロパティをインデックスとしてAddしたものを、
‘ 再度Addしようとするとエラーになることを利用して、
‘ 削除対象を特定します。
‘ より確実な方法としては、Shapeオブジェクト自体をCollectionに格納する方法がありますが、
‘ ここではNameをキーとしています。
‘ 実際には、shapeNameがShapeオブジェクトそのものを指すようにCollectionを定義し直す方が良いでしょう。
‘ ここでは、CollectionにShapeオブジェクトを格納する前提で修正します。
‘ 上記のCollectionへの追加部分を ShapeCollection.Add sh2 に変更し、
‘ Collectionの型を Collection Of Shape に変更する必要があります。
‘ 標準の Collection はVariant型しか格納できないため、
‘ 実際にはクラスモジュール等でカスタムコレクションを作成するか、
‘ 削除対象のShapeオブジェクトを配列で管理するのが一般的です。
‘ 今回は、CollectionにShapeオブジェクトを直接追加するのではなく、
‘ 削除対象のShapeオブジェクトを別の配列に格納し、それを削除する方式に変更します。
Dim shapesToDeleteArray() As Shape
Dim deleteCount As Long
deleteCount = 0
‘ 削除対象リスト（Collection）にあるShapeオブジェクトを、削除用配列にコピー
For i = 1 To numShapes
Set sh1 = shapeArray(i)
On Error Resume Next
shapesToDelete.Add sh1, sh1.Name ‘ 削除対象リストに存在するか確認
If Err.Number = 0 Then ‘ 削除対象リストに存在しない場合（つまり、削除対象ではない）
‘ 何もしない
Else ‘ 削除対象リストに存在する場合
‘ 削除対象配列に格納
ReDim Preserve shapesToDeleteArray(1 To deleteCount + 1)
Set shapesToDeleteArray(deleteCount + 1) = sh1
deleteCount = deleteCount + 1
End If
Err.Clear
Next i
‘ 削除対象配列にあるShapeを削除
For i = 1 To deleteCount
shapesToDeleteArray(i).Delete
Next i
MsgBox “重なっていた画像（後から配置されたもの）を” & deleteCount & “個削除しました。”, vbInformation
Exit Sub ‘ 処理を終了
Next shapeName ‘ このループは実際には実行されません。上記で処理を終了しています。
Else
MsgBox “重なっている画像はありませんでした。”, vbInformation
End If
End Sub
**コードの解説:**
1. **`DeleteOverlappingImages()` サブルーチン:** 画像削除処理を実行するメインのサブルーチンです。
2. **`Dim ws As Worksheet`:** 対象となるワークシートを格納する変数です。
3. **`Dim sh1 As Shape, sh2 As Shape`:** 比較対象となる2つのShapeオブジェクトを格納する変数です。
4. **`Dim shapeArray() As Shape`:** シート上のShapeオブジェクトを一時的に格納するための動的配列です。Shapeオブジェクトの追加・削除によるインデックスの変動を避けるために使用します。
5. **`numShapes = ws.Shapes.Count`:** シート上のShapeオブジェクトの総数を取得します。
6. **`ReDim shapeArray(1 To numShapes)`:** Shapeオブジェクトの数に合わせて配列のサイズを決定します。
7. **`For Each sh1 In ws.Shapes … shapeArray(i) = sh1`:** シート上のShapeオブジェクトを順番に配列に格納します。
8. **`For i = 1 To numShapes … For j = i + 1 To numShapes`:** 二重ループで、すべてのShapeオブジェクトのペアを比較します。`j = i + 1` とすることで、自分自身との比較や、既に比較済みのペアとの重複比較を避けています。
9. **重なり判定ロジック:**
* `sh1.Top >= sh2.Top + sh2.Height`：sh1がsh2の完全に下にある場合
* `sh1.Top + sh1.Height <= sh2.Top`：sh1がsh2の完全に上にある場合
* `sh1.Left >= sh2.Left + sh2.Width`：sh1がsh2の完全に右にある場合
* `sh1.Left + sh1.Width <= sh2.Left`：sh1がsh2の完全に左にある場合
これらの条件のいずれにも当てはまらない場合（つまり、いずれかの境界線が重なっている場合）に、2つのShapeは重なっていると判断されます。
10. **`shapesToDelete.Add sh2, sh2.Name`:** 重なっていると判断された場合、後から出てきた方（`sh2`）を削除対象として `shapesToDelete` コレクションに追加します。`sh2.Name` をキーとして追加することで、同じShapeが複数回追加されるのを防ぎます。
11. **`shapesToDeleteArray()` と `deleteCount`:** 削除対象のShapeオブジェクトを格納するための動的配列 `shapesToDeleteArray` と、その要素数をカウントする `deleteCount` を使用します。これは、VBAの標準CollectionオブジェクトにShapeオブジェクトを直接格納し、後でそれらを削除するのが複雑なため、代替手段として配列を使用しています。
12. **`For i = 1 To numShapes ... ReDim Preserve shapesToDeleteArray(1 To deleteCount + 1) ... Set shapesToDeleteArray(deleteCount + 1) = sh1`:** 最初のShape配列 (`shapeArray`) を再度ループし、`shapesToDelete` コレクションに名前が存在するShapeオブジェクトを `shapesToDeleteArray` に格納します。
13. **`For i = 1 To deleteCount ... shapesToDeleteArray(i).Delete`:** 最後に、`shapesToDeleteArray` に格納されたShapeオブジェクトを一つずつ削除します。
14. **メッセージボックス:** 削除が完了した旨、または重なっている画像がなかった旨をユーザーに通知します。
**注意点:**
* このコードは、アクティブシート上のすべての画像（Shapeオブジェクト）を対象とします。必要に応じて、特定のシートや特定の種類のShapeのみを対象とするようにコードを修正してください。
* `shapesToDelete` コレクションへのShapeオブジェクトの追加と削除処理は、VBAのCollectionオブジェクトの特性上、少し複雑になっています。より洗練された実装としては、カスタムクラスモジュールでCollectionオブジェクトを定義するか、Shapeオブジェクト自体を格納できる配列を直接使用することが考えられます。
* 削除対象の決定ロジック（`sh2` を削除対象とする）は、あくまで一例です。要件に応じて、削除するShapeの条件（例：サイズが小さい方、特定の名前を持つ方など）を変更してください。
* 多数の画像がある場合、処理に時間がかかる可能性があります。
実務アドバイス
このVBAコードは、Excelでの画像管理作業を劇的に効率化する可能性を秘めています。以下に、実務で活用する上でのアドバイスをいくつかご紹介します。
* **バックアップの徹底:** VBAコードを実行する前に、必ず対象のExcelファイルをバックアップしてください。画像削除は元に戻せない操作です。
* **対象範囲の限定:** すべての画像を対象にするのではなく、特定のシートや、特定のセル範囲に配置された画像のみを対象とするようにコードを修正すると、より安全かつ目的に沿った処理が可能になります。例えば、`If sh1.Top >= Range(“A1”).Top And sh1.Bottom <= Range("B10").Bottom And sh1.Left >= Range(“A1”).Left And sh1.Right <= Range("B10").Right Then` のような条件を追加することで、特定の範囲内の画像のみを対象にできます。
* **削除条件のカスタマイズ:** サンプルコードでは、後から配置された画像を削除していますが、削除する画像の条件は自由にカスタマイズできます。例えば、以下のような条件を追加できます。
* **画像サイズで判断:** `If sh1.Width * sh1.Height < sh2.Width * sh2.Height Then` （小さい方を削除）
* **画像名で判断:** 特定のプレフィックスを持つ画像を削除対象外とする。
* **画像が特定のセルを覆っているかで判断:** 画像が特定のセル範囲を完全に覆っている場合に削除するなど。
* **実行前の確認:** 削除対象となる画像を事前にリストアップし、ユーザーに確認を求める機能を実装すると、誤削除を防ぐことができます。`MsgBox` で確認を求めたり、削除対象のShapeの名前を一時的に別のシートに出力したりするなどの方法が考えられます。
* **トリガーの設定:** このVBAコードを、特定のボタンに割り当てたり、シートのイベント（例：シートの保護解除時、特定の値が変更された時など）に連動させたりすることで、より自動化された運用が可能です。
* **パフォーマンスの最適化:** 非常に大量の画像（数百、数千個以上）を扱う場合、処理速度が問題になることがあります。その場合は、画像の座標情報を元にグリッドを作成し、各グリッド内の画像のみを比較対象とするなどのアルゴリズムの最適化を検討してください。また、`Application.ScreenUpdating = False` と `Application.Calculation = xlCalculationManual` をコードの最初と最後に配置することで、画面更新と再計算を一時的に無効にし、処理速度を向上させることができます。
* **エラーハンドリングの強化:** `On Error Resume Next` は便利ですが、予期せぬエラーを見逃す可能性もあります。より堅牢なコードにするためには、具体的なエラー内容を把握し、適切なエラー処理を記述することが望ましいです。
* **Shapeオブジェクトの種類:** このコードは `Shape` オブジェクト全般に作用します。画像だけでなく、図形（長方形、楕円など）も含まれます。画像のみを対象としたい場合は、`sh1.Type` プロパティを確認し、`msoPicture` または `msoLinkedPicture` であるかを判定する条件を追加してください。
これらのアドバイスを参考に、ご自身の業務に合わせてVBAコードをカスタマイズし、Excel作業の効率化に役立ててください。
まとめ
Excelで意図せず重なってしまった画像や、不要な画像が複数配置されてしまう問題は、手動での削除に多大な時間を費やす原因となります。今回ご紹介した「VBA100本ノック」90本目の内容では、VBAを使用してこれらの重なっている画像を自動的に検出し、削除する方法を解説しました。Shapeオブジェクトの座標情報を比較するロジックと、それを実現するための具体的なVBAコードを提供し、その実装方法を詳細に説明しました。
このVBAコードを活用することで、画像管理にかかる手間を大幅に削減し、作業効率を劇的に向上させることが期待できます。さらに、実務で活用する上での注意点や、より高度なカスタマイズ、パフォーマンス向上に関するアドバイスも提供しました。
VBAは、Excelの定型作業を自動化し、生産性を高める強力なツールです。今回学んだ画像削除のテクニックを皮切りに、ぜひ様々な業務へのVBA適用を検討してみてください。Excel VBAの習得は、日々の業務をより快適で効率的なものにするための、確実な一歩となるでしょう。
