マクロのエラーの原因を教えてください。

マクロ初心者です。何度かこちらで教えていただきながら、
やっとマクロが完成して、実行してみたら、思っていた動きは
すべて実行することができました。

しかし、最後に
『実行時エラー 438 オブジェクトはこのプロパティまたはメソッドをサポートしていません。』
というエラーメッセージが表示されてしまったのです。

デバックをクリックして見てみると
一番下のEnd Subから３行上のあたりで、
『 For Each Shapes In ActiveSheet.Shape』というところが
黄色くなっていました。

これはどうしたらマクロの動きはいまのままで、直すことができるのでしょうか？




マクロの動き方としては
３つの動き方をするようにしています。

まず、まとめシートのB1で『場所』を選択すると
チェック結果シートにある該当する場所のチェック１～４の値を
コピーしてまとめシートに貼り付けてくれるマクロがあります。

次に、まとめシートに貼り付けられたチェック１～４の値は
ハイパーリンクなのですが、
まとめシートのE列にそれぞれのハイパーリンクのアドレスを表示してくれる
動きをするマクロがあります。

最後に、このハイパーリンクはそれぞれ画像と紐づいているので、
その画像をD列に既定のサイズで貼り付けてくれるマクロにしてあります。






Sub チェック開始()

Dim c As Range, wS As Worksheet
Set wS = Worksheets("チェック結果")
With Worksheets("まとめ")
Set c = wS.Range("J:J").Find(what:=.Range("B1"), LookIn:=xlValues, lookat:=xlWhole)
If Not c Is Nothing Then
wS.Cells(c.Row, "R").Resize(, 4).Copy
.Range("C2").PasteSpecial Paste:=xlPasteAll, Transpose:=True
Else
MsgBox "該当データなし"
End If
End With
Application.CutCopyMode = False


Dim h As Hyperlink
Dim a As String
Dim s As String
For Each h In ActiveSheet.Hyperlinks


a = h.Address
s = h.SubAddress
If s <> "" Then
a = a & " # " & s
End If
h.Range.Offset(0, 2) = a

Next


Dim i As Long, imax As Long
Dim sp As Shapes
imax = Cells(Rows.Count, 5).End(xlUp).Row
For i = 2 To imax
If Cells(i, 5).Value <> "" Then
Cells(i, 4).Select
p = "" & Cells(i, 5).Value & ""
ActiveSheet.Pictures.Insert(p).Select
Selection.ShapeRange.LockAspectRatio = msoTrue
Selection.ShapeRange.Width = Selection.ShapeRange.Width * 0.25
Selection.ShapeRange.Height = Selection.ShapeRange.Height * 1.25
End If
Next
For Each Shapes In ActiveSheet.Shape
Next

End Sub



どうしたら『 For Each Shapes In ActiveSheet.Shape』の
黄色は直るのでしょうか？
お手数お掛けしますが、何卒お願い致します。

No.1 ベストアンサー 回答者： GooUserラック 回答日時： 2018/01/18 10:20

すみません。

単純な質問ですが「For Each Shapes In ActiveSheet.Shape」と「Next」の２行は何をやっているのでしょうか？そもそも間に何もないので不要ではないでしょうか？

この回答へのお礼

GooUserラック様

いつも教えていただきありがとうございます。

ご指摘の2行を削除したら問題なく動きました。
ありがとうございました！

お礼日時：2018/01/18 16:30

No.3 回答者： t_fumiaki 回答日時： 2018/01/18 12:32

For Each Shapes In ActiveSheet.Shape←間違い

For Each oShape In ActiveSheet.Shapes←正しい

全部処理が終わったら、そのシートの図形を全て削除してますが、それでもokですか？

No.2 回答者： poco_2 回答日時： 2018/01/18 10:24

こんにちは。

For Each Shapes In ActiveSheet.Shape
は
For Each [Dimで指定する変数] In ActiveSheet.Shapes
の間違いでしょうね。

でもそもそも
For Each Shapes In ActiveSheet.Shape
Next
では結果的に何もしていないことは理解してますか？
この２行は削除でいいのでは？

この回答へのお礼

poco_2様
ありがとうございます。
無事、エラーメッセージが解消されました。

お礼日時：2018/01/18 16:31