ハイパーリンクからアドレスを取得して画像を貼りつけるマクロを教えてください。

マクロ初心者です。
ネットで調べながら、教えていただきながら、
なんとか少しずつ前に進んでいる私をお助け下さい。


【前提としては】
C列には○×のハイパーリンクが貼られています。
しかし、C３のように途中にハイパーリンクが無いものもあります。
ハイパーリンクはそれぞれクリックすると写真が表示されるようになっています。


【現状のマクロの動きとしては】
C列のハイパーリンクを受けてE列にアドレスが表示されるようになっています。
そしてそのE列のアドレスを受けてD列に写真が表示されるようになっています。

つまり、C３のセルのように、ハイパーリンクが無いと、E３のセルにアドレスが表示されません。
E３のセルにアドレスが表示されないと、D３のセルに写真が表示されません。


【問題としては】
E列にアドレスの表示をするマクロはC３のように
ハイパーリンクが途中なくてもそこは飛ばして
次のC4からのアドレスをE4からに表示してくれるようになっています。

しかし、写真表示のマクロはE3のようにアドレスがないと
D３以降の写真を貼りつけずに止まってしまします。

恐らく if で分岐するのだと思いますが、
その書き方がわからず困っています。

下記に現状のマクロも記載します。
お手数お掛けしますが、どうか教えてください。
よろしくお願い致します。



【現状のマクロ】

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
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
Next
For Each sp In ActiveSheet.Shapes
Next
End Sub

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

「For i = 2 To imax」と「Cells(i, 4).Select」の間に「If Cells(i, 5).Value <> "" Then」

「Selection.ShapeRange.Height = Selection.ShapeRange.Height * 1.25」と「Next」の間に「End If」
をそれぞれ入れれば良いのでは？

この回答へのお礼

GooUserラック様

無事、思い通りの動きをしてくれるようになりました。
大変助かりました！ありがとうございます！！

お礼日時：2018/01/15 18:15