Excelマクロで画像ファイルのリンクを設定する

JPEG形式の画像ファイル名を入力したExcelシートがある。

画像ファイル名をクリックするだけで画像を表示できるよう、実ファイルへのリンクをセルに設定したいところだが、画像ファイルの数が１万件以上あったので、手作業で進めるのは現実的では無かった。

ということで、リンクを自動で設定するマクロを書いてみた。

Sub リンク設定()
    Dim wb As Workbook, ws As Worksheet, r As Range
    Dim s画像フォルダパス As String, sファイル名 As String
    
    Const 画像フォルダ名 As String = "画像"

    ' 対象Excelファイルのチェック
    Set wb = ActiveWorkbook
    If ThisWorkbook Is wb Then
        MsgBox "Excelファイルが選択されていません", vbCritical
        Exit Sub
    End If
    
    s画像フォルダパス = ThisWorkbook.Path & "\" & 画像フォルダ名

    ' 全シートの
    For Each ws In wb.Sheets
        ' 全セルを調べる
        For Each r In ws.UsedRange
            
            sファイル名 = LCase(Trim(r.Text))
            
            If sファイル名 Like "*.jpg" Then  ' JPEGファイルなら
                If Dir(s画像フォルダパス & "\" & sファイル名) <> "" Then  ' ファイルが存在したら
                    ws.Hyperlinks.Add r, 画像フォルダ名 & "\" & sファイル名  ' 相対パスでリンクを設定
                End If
            End If
        
        Next
    Next
End Sub

マクロ本体と、対象のExcelファイルを開き、[Alt]+[F8] で実行する。

一瞬でリンクに早変わり！

相対パスでリンクしているので、フォルダ構成を変えない限り、別環境に移しても問題ない。

ちなみに、Microsoft Windows Image Acquisition Library (WIA) を使えば、画像ファイルの撮影日時（Exif）をVBAから読み取ることも容易だが、今回はExif情報が記録されていない画像だったのでやらなかった。