Excel VBAの実行時エラー1004を解決する方法|Shapes削除処理でIntersectが失敗する原因と対策

Excel

Excel VBAで図形(オートシェイプ)を大量に配置したシートを処理していると、突然「実行時エラー1004 アプリケーション定義またはオブジェクト定義のエラーです」が発生することがあります。特にShapesコレクションをループし、図形の位置から削除対象を判定する処理では、長期間問題なく動いていたマクロでも特定の図形が混ざったことで停止する場合があります。

この記事では、Excel VBAで「Intersect(Range(sp.TopLeftCell, sp.BottomRightCell), myRng)」の部分でエラー1004が発生する原因と、安全に図形を削除するための修正方法を解説します。

Intersect処理でエラー1004が発生する仕組み

問題になっているコードは以下の部分です。

If Not Intersect(Range(sp.TopLeftCell, sp.BottomRightCell), myRng) Is Nothing Then

この処理では、図形(Shape)の左上セルと右下セルを取得し、その範囲が指定範囲(myRng)と重なっているかを確認しています。

通常のオートシェイプであれば正常に動作しますが、Excel内部ではすべてのShapeがセル範囲を持つとは限りません。そのため、特定の図形を処理した瞬間にTopLeftCellやBottomRightCellが正常なRangeオブジェクトとして取得できず、Intersectでエラーになることがあります。

削除できたのに最後にエラーになる理由

今回のように「指定範囲のオートシェイプはすべて削除されているのにエラーで停止する」という現象は珍しくありません。

For EachでShapesを順番に処理している場合、対象図形を削除した後でも、次に確認する図形が存在していれば処理は続きます。

例えば500個の図形があり、対象範囲の図形が499個目までで削除されたとしても、最後の500個目の図形が特殊なShapeだった場合、その図形の判定時にエラーが発生します。そのため、結果を見ると削除は完了しているように見えます。

また、バックアップファイルの片方だけエラーになる場合も、ファイル内部の図形情報や不要なオブジェクトの状態が微妙に異なる可能性があります。

原因になりやすい図形やオブジェクト

TopLeftCellやBottomRightCellが問題になる代表的なケースには以下があります。

  • グループ化された図形
  • グラフオブジェクト
  • フォームコントロール
  • コメントや特殊な描画オブジェクト
  • コピーや貼り付けを繰り返したことで内部情報が壊れた図形

見た目が普通のオートシェイプでも、Excel内部では通常のShapeとは異なる種類として保存されている場合があります。

特に5年以上同じブックを使用している場合、編集履歴によって図形情報が複雑化し、突然問題が発生することがあります。

エラーを防ぐ安全なVBAコードへの修正方法

図形を削除する処理では、すべてのShapeが正常にセル情報を取得できるとは限らないため、エラー処理を入れておく方法が有効です。

例えば以下のように変更できます。

For Each sp In ActiveSheet.Shapes
On Error Resume Next
If Not Intersect(Range(sp.TopLeftCell, sp.BottomRightCell), myRng) Is Nothing Then
sp.Delete
End If
On Error GoTo 0
Next

On Error Resume Nextを使うことで、問題のある図形があっても処理を停止せず次の図形へ進むことができます。

ただし、エラーを完全に無視するだけでは原因が分からなくなるため、重要な処理ではエラー発生時にログを残す方法がおすすめです。

より安全なShape削除方法

大量の図形を扱う場合は、削除対象を後からまとめて削除する方法も有効です。

For Eachでループ中にsp.Deleteを実行すると、Shapesコレクションの番号や状態が変化するため、予期しない動作につながることがあります。

例えば以下のように、一度削除対象を記録してから削除します。

Dim delShapes As Collection
Set delShapes = New Collection

For Each sp In ActiveSheet.Shapes
On Error Resume Next
If Not Intersect(Range(sp.TopLeftCell, sp.BottomRightCell), myRng) Is Nothing Then
delShapes.Add sp.Name
End If
On Error GoTo 0
Next

For Each s In delShapes
ActiveSheet.Shapes(s).Delete
Next

この方法なら、判定中にShapesコレクションが変化しないため、500個以上の図形を扱う場合でも安定しやすくなります。

原因調査のために確認したいポイント

エラーを根本的に解決するには、どの図形で問題が発生しているか確認することも重要です。

以下のようなコードを一時的に追加すると、問題の図形を特定できます。

Debug.Print sp.Name, sp.Type

エラーが発生する直前に表示されたShapeを確認すると、通常とは異なるオブジェクトが混ざっている可能性があります。

また、不要な図形を選択して削除したり、図形をコピーして新しいシートへ移動することで内部情報がリセットされる場合もあります。

長期間使用するExcelマクロで重要な対策

毎月実行するような業務マクロでは、正常動作している時からエラー対策を入れておくことが大切です。

特に図形処理、ファイル操作、外部データ取得などは、Excelの状態によって突然失敗することがあります。

今回のような処理では「すべてのShapeが正常なRange情報を持つ」という前提を置かず、例外処理やログ記録を組み込むことで、将来的な停止リスクを減らせます。

まとめ:VBAのIntersectエラー1004は図形情報の例外処理が重要

Excel VBAでShapesを範囲判定して削除する処理では、一部の図形がTopLeftCellやBottomRightCellを正しく取得できないことで、実行時エラー1004が発生することがあります。

今回のように削除自体は完了している場合でも、最後に確認した図形が原因でマクロが停止するケースがあります。

対策としては、エラー処理を追加する、削除対象を一旦記録してから削除する、問題のあるShapeを特定するなどの方法が有効です。大量の図形を扱う業務マクロほど、例外を想定したコードに修正しておくことで安定した運用ができます。

コメント

タイトルとURLをコピーしました