アプリ版:「スタンプのみでお礼する」機能のリリースについて

 図形を二行三列で一枡とし図形を貼り付けていますが、どうしても実行時エラー
「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

A 回答 (1件)

shape.TopLeftCellはRangeオブジェクトになるので、


ここではshape.TopLeftCell.Addressとするのでは?
If Not Intersect(Range(sp.TopLeftCell.Address, sp.BottomRightCell.Address), myRng) Is Nothing Then
で通ると思います。
    • good
    • 0
この回答へのお礼

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

お礼日時:2013/03/25 14:13

お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!