画像サムネイルとハイパーリンクを設定

'/********************************************************
'/* 画像をシートに並べてハイパーリンクを設定する
'/* 1.画像ファイル(.jpg)を選択する(複数選択可)
'/* 2.画像ファイルのサムネイルをシートに並べる
'/* 3.画像ファイルへのハイパーリンクをシートに設定する
'/********************************************************
Public Sub 画像をシートに並べて表示する()
    On Error GoTo ErrorOccurred
    
    Dim gazoFiles() As String
    Dim iret As Integer, i As Integer
    Dim stcol As Integer, strow As Integer
    Dim filename As String
    
    '//ファイル選択ダイアログで画像ファイルを選択する
    With Application.FileDialog(msoFileDialogFilePicker)
        '選択可能ファイル(.jpg)設定
        .Filters.Add "画像ファイル(Jpeg)", "*.jpg"
        '複数ファイル選択可能
        .AllowMultiSelect = True
        
        'ファイルピッカー表示
        If .Show = False Then
            Exit Sub
        Else
            'SelectedItemsはインデックス1から開始するのでFor文で実装する際は注意
            i = 0
            For Each tmpstr In .SelectedItems
                ReDim Preserve gazoFiles(i)
                gazoFiles(i) = tmpstr
                i = i + 1
            Next
        End If
    End With
    
    '//シートを初期化していいか確認メッセージを表示する
    iret = MsgBox(ActiveSheet.Name & " : シートを初期化してもよろしいですか？", _
        vbYesNo + vbQuestion, "画像をシートに並べて表示する")
    If iret = vbNo Then Exit Sub
    
    '//シートを初期化する
    シートクリア ActiveSheet.Name
    
    '//画像のサムネイルとハイパーリンクを設定
    i = 1
    stcol = 2
    strow = 2
    For Each tmpstr In gazoFiles
        'ハイパーリンクを設定
        '詳細はOfficeデベロッパーセンター参照
        'https://docs.microsoft.com/ja-jp/office/vba/api/excel.hyperlinks.add
        filename = Mid(tmpstr, InStrRev(tmpstr, "\") + 1)
        Range(Cells(strow, stcol), Cells(strow, stcol)).Select
        ActiveSheet.Hyperlinks.Add _
                Anchor:=ActiveSheet.Range(Cells(strow, stcol), Cells(strow, stcol)), _
                Address:=tmpstr, _
                ScreenTip:=tmpstr, _
                TextToDisplay:=filename
            
        'サムネイル画像を設定
        Range(Cells(strow + 1, stcol), Cells(strow + 1, stcol)).Select
        ActiveSheet.Pictures.Insert(tmpstr).Select
        Selection.ShapeRange.Height = 150
            
        '次の開始位置を算出(横方向は最大4画像とする)
        If (i Mod 4) = 0 Then
            stcol = 2
            strow = strow + 12
        Else
            stcol = stcol + 13
        End If
        '次の画像はi番目
        i = i + 1
    Next
        
    Range("A1").Select
    Exit Sub
    
ErrorOccurred:
    MsgBox "何かエラーが発生しました", vbCritical
End Sub

'/********************************************************
'/ シートをクリアする
'/ stname：クリア対象シート名
'/********************************************************
Private Sub シートクリア(ByVal stname As String)
    Dim sp As Variant
     
    '//シート選択
    ThisWorkbook.Sheets(stname).Activate
    '//セルを初期化する
    Cells.Select
    Selection.UnMerge
    Selection.Clear
    Selection.ColumnWidth = 3
    Selection.RowHeight = 17
    Selection.Font.Name = "Meiryo UI"
    Selection.Font.Size = 12
    Selection.Borders.LineStyle = False
    '//中央揃えを設定
    Selection.HorizontalAlignment = xlLeft
    Selection.VerticalAlignment = xlCenter
    '//セルの折り返しを解除
    Selection.WrapText = False
   
    '//オートシェイプを削除する
    For Each sp In ActiveSheet.Shapes
        sp.Delete
    Next
   
    ActiveWindow.Zoom = 80
    Range("A1").Select
End Sub