やはり図形のクリアで実行時エラー1004

質問

図形を二行三列で一枡とし図形を貼り付けていますが、どうしても実行時エラー
「1004」が出て図形のクリアができません。(尚、四角形は枠線上にあります。)
対処法がありましたらお願いします。

Windows7・SP1 Office2010

Sub 図形の貼付け()

Dim i As Integer
Dim j As Integer

For i = 10 To 43 Step 2
For j = 9 To 99 Step 3

Select Case Cells(i, j).Value
Case 1:
ActiveSheet.Shapes("四角形1").Select
Selection.Copy
Cells(i + 1, j + 1).Select
ActiveSheet.Paste
Case 2:
ActiveSheet.Shapes("四角形2").Select
Selection.Copy
Cells(i + 1, j).Select
ActiveSheet.Paste
Case 4:
ActiveSheet.Shapes("四角形3").Select
Selection.Copy
Cells(i + 1, j + 1).Select
ActiveSheet.Paste
Case 5:
ActiveSheet.Shapes("四角形3").Select
Selection.Copy
Cells(i + 1, j + 2).Select
ActiveSheet.Paste
Case 6:
ActiveSheet.Shapes("円1").Select
Selection.Copy
Cells(i, j).Select
ActiveSheet.Paste
End Select
Next
Next
End Select
End　Sub

Sub 図形のクリア()

Dim myRng As Range
Set myRng = Range("I10:CW43")
Dim n As Integer, sp As Variant
For n = ActiveSheet.Shapes.Count To 1 Step -1
Set sp = ActiveSheet.Shapes(n)
If Not Intersect(Range(sp.TopLeftCell, sp.BottomRightCell), myRng) Is Nothing
　(ここで実行時エラー1004になります。)
Then
sp.Delete
End If
Next
Set myRng = Nothing

End Sub

回答No.1

jin34 · ベストアンサー

shape.TopLeftCellはRangeオブジェクトになるので、
ここではshape.TopLeftCell.Addressとするのでは？
If Not Intersect(Range(sp.TopLeftCell.Address, sp.BottomRightCell.Address), myRng) Is Nothing Then
で通ると思います。

お礼

御丁寧な解答ありがとうございます。
全く実行されにのではなく幸いにも正常に動作するバックアップファイルがありますのでご指摘の
コードに書換えて様子を見たいと思います。