エクセルマクロで指定範囲内の図形を削除

エクセルマクロで指定範囲内の図形を削除する、
マクロをインターネット上で取得応用しているのですが、

範囲内に図形がない場合、でも動作するようにしたいです。
現状範囲内に図形が一つでもあれば、正常終了するのですが、
ない場合1004エラーで止まります。

どうにかならないでしょうか？

下記が使用中のマクロです。

Dim myRng As Range
Dim sp As Object

Set myRng = Range("A14:AR57")

Range("A14:AR57").Select
Range("A14").Activate

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

Set myRng = Nothing

このマクロの
If～Then構文にて1004エラーがでます。

急いでいます
教えてください。

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

• 

  追加補足です
  なにかでエラーとしかわからない状態です。
  たまに正常終了します。
  
  ただ大半はエラーではじかれます
  
  範囲外にはコントロールボタンやプルダウンはありますが、
  範囲内は罫線が描かれている以外何もありません

    補足日時：2017/06/07 17:49

No.6 回答者： cj_mover 回答日時： 2017/06/11 20:11

No.2 さん推しです。

.Shapes
を
.DrawingObjects
に書き換えるだけで簡単そうだし。

> 範囲内に図形がない場合、でも動作するようにしたいです。
> 現状範囲内に図形が一つでもあれば、正常終了するのですが、
> ない場合1004エラーで止まります。

図形がない筈、と思ってみているけれど、
[入力規則]の[リスト]のDropDownがあったとすると、
これは、Shapesのアイテムなのに、
.TopLeftCellも.BottomRightCellも属性として持たないので、
「'1004'オブジェクト定義」エラーになるとか、、、。
確かに昔はShapesのお仲間オブジェクトは他にも幾つかありましたね。
その点、.DrawingObjectsなら、
そもそもDropDownを相手にしてないとか、、、。
まぁバージョンによる変化が多い部分なので、
断言するのは現状、難しいとか、、、。

よく読んだら、補足コメントに
> 範囲外にはコントロールボタンや【プルダウン】はありますが、
と書いてありますね。

DrawingObjectsって、隠れキャラ（VBE非表示メンバー）なので、
馴染みがなく不安とか、だったら、別途皆さんに訊いてみて下さい。
非表示メンバーの中では使用頻度の高いものでですので、
情報は多いと思いますけれど、、、。
私はこれにて退散します。

No.5 回答者： end-u 回答日時： 2017/06/11 16:18

>このマクロの

>If～Then構文にて1004エラーがでます。
なんですよねー

シートモジュールだったら
＞Range("A14:AR57").Select
ここが1004エラーのはずなんですよねー

#や。別にSelect推奨してるわけではないです　:)

No.4 回答者： WindFaller 回答日時： 2017/06/10 20:00

ちょっとコメントさせていただきます。

最初は、「幽霊オブジェクト」かと思いましたが、コードに少し気になる部分はありますね。

>If～Then構文にて1004エラーがでます。
だいたい、この種にコードで、ランタイムエラーの1004が出るということは、初歩的なミスではないでしょうか。On Error Goto ErrHandler でも、Runtime Error1004では分かりません。

For Each sp In ActiveSheet.Shapes
If Not Intersect(Range(sp.TopLeftCell, sp.BottomRightCell), myRng) Is Nothing Then
sp.Delete
End If

ActiveSheet.Shapes
　　と
Range(sp.TopLeftCell, sp.BottomRightCell)

の親オブジェクトの整合性が取れていないのではありませんか？
早い話が、標準モジュールに書かれていないのではないでしょうか。

そのままのコードで通したいのでしたら、以下のような、With ステートメントでくくらないとダメです。正しくは、標準モジュールに移すかどちらかだと思います。
（そうでなかったら、ご容赦のほどを）
'----------------------
Dim myRng As Range
Dim sp As Object

With ActiveSheet
Set myRng = .Range("A14:AR57")

'2行は不要
''Range("A14:AR57").Select
''Range("A14").Activate

For Each sp In .Shapes
If Not Intersect(.Range(sp.TopLeftCell, sp.BottomRightCell), myRng) Is Nothing Then
sp.Delete
End If
Next

End With
Set myRng = Nothing
'----------------------

No.3 回答者： VT250F 回答日時： 2017/06/10 09:34

オンエラー文を使う手があります。

その時、ステップ変数 Dim wStep as long でコード上から wStep = 1000
wStep = 2000 などと数行毎に記しておきます。
問題の行でエラーにジャンプするなら
Msgbox "エラーだよ" & Err.Number & " " & Err.デスクリプション（つづり忘れました）
Stop
Resume Next
くらいしておけばよいでしょう。
エラーの原因をエラー名称から調べて回避するのが最もよいですが、
ひとまず完成にこぎつかす為によくやる手です。

No.2 回答者： end-u 回答日時： 2017/06/07 22:30

Excelのバージョンにもよりますが、まずは単純なコードで確認したほうが良いでしょうね。

Sub test()
　　Dim sp As Shape
　　For Each sp In ActiveSheet.Shapes
　　　　sp.Visible = msoTrue
　　　　Debug.Print sp.Name, sp.TopLeftCell.Address
　　Next
End Sub

Ver2003の場合、上のコードでも、ある環境下でエラーになります。
TopLeftCellを持たないShapeがあるという意味です。
「Drop Down」つまりオートフィルタの▼。
以降のバージョンは改善されたように記憶してますが。

2003以前ならDrawingObjectsのLoopならいけたんじゃなかったっけかなー？（あやふや;|
Sub test2()
　　Dim d As Object
　　For Each d In ActiveSheet.DrawingObjects
　　　　d.Visible = msoTrue
　　　　Debug.Print d.Name, d.TopLeftCell.Address
　　Next
End Sub

No.1 回答者： yokomaya 回答日時： 2017/06/07 14:43

こちらで試しましたが再現しませんね。

図形が無くてもちゃんと終了しました。
エラーが出た時にspが何を指しているかとか
その時のTopLeftCellとかイミディエイトウィンドウで
確認するのが近道ではないでしょうか？