→ ＶBAＰrojectを右クリック → 挿入 → 標準モジュール
→ 以下のコードを貼り付け
ーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーー
'指定セルにハイパーリンクされた画像ファイルのフルパスをカレントセルに表示し、
'その画像を左隣セルに貼りつける関数
'---- pic_paste(セル番号）----
'
Function pic_paste(fname As Range)
Const n As Long = 2 'margin
Dim r As Range
Dim i As Long
Dim x As Double
Dim s As String
Set r = Application.ThisCell.Offset(0, 1).MergeArea
If fname.Hyperlinks.Count > 0 Then
s = fname.Hyperlinks(1).Address
Else
s = "--"
End If
ChDir ActiveWorkbook.Path
If Dir(s) = "" Then
pic_paste = s
Else
'Dir Application.Path
pic_paste = s
With ActiveSheet.Pictures.Insert(s).ShapeRange
.LockAspectRatio = msoTrue
x = Application.Min(r.Width / .Width, (r.Height - n) / .Height)
.Width = .Width * x
.Left = r.Left
.Top = r.Top + n / 2
End With
End If
End Function
ーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーー
