【エクセルVBA】画像をエクセルに貼るマクロ2

こんにちは、pothです。
前回「画像をエクセルに貼るマクロ1」で紹介しいたマクロのコードを以下に貼っておきます。
ドシロウトのコードなので使用する場合は自己責任でお願いします。

準備としてはシートのB1セルに列数、B2に画像高さを書いておけば使えます。

Sub pasteDirImage()
' 変数定義
Dim firstRow As Integer
Dim myFileName As String
Dim targetCol As Integer
Dim targetCell As Range
Dim shell As Object
Dim myPath As Object
Dim pos As Integer
Dim isImage As Boolean
Dim tempPath As String
Dim picHeight As Long
Dim picWidth As Long
    
firstRow = 3  '画像を貼り付け開始行を指定
tempPath = ActiveWorkbook.Path  'このエクセルファイルが保存されている場所を取得
picHeight = Range("B2").Value   '貼り付ける画像の高さを取得
    
' フォルダ選択画面を表示
Set shell = CreateObject("Shell.Application")
Set myPath = shell.BrowseForFolder(&O0, "画像が保存されているフォルダを選んでください", _
                                    &H1 + &H10, tempPath & "\")
Set shell = Nothing
 
' フォルダを選択したら...
myFileName = Dir(myPath.Items.Item.Path + "\")
i = 0
Do While myFileName <> ""
    ' ファイル拡張子の判別
    isImage = True
    pos = InStrRev(myFileName, ".")
    If pos > 0 Then
        Select Case LCase(Mid(myFileName, pos + 1))
            Case "jpeg"
            Case "jpg"
            Case "gif"
            Case "tif"
            Case Else
                isImage = False
            End Select
        Else
            isImage = False
    End If
    ' 拡張子が画像であれば
    If isImage = True Then
        targetCol = 1 + i * picWidth    ' 貼り付ける列指定
        ' 貼り付け先を選択
        Cells(firstRow, targetCol).Select
        ' 貼り付け
        Set targetCell = ActiveCell
        Set myShape = ActiveSheet.Shapes.AddPicture( _
            fileName:=tempPath & "\" & myFileName, _
            LinkToFile:=True, _
            SaveWithDocument:=False, _
            Left:=Selection.Left, _
            Top:=Selection.Top, _
            Width:=0, _
            Height:=0)
        With myShape
            .LockAspectRatio = True
            .ScaleHeight 1, msoTrue
        End With
        ' 画像のサイズを調整
            myShape.Select
            Selection.Height = targetCell.Height * picHeight
        ' 貼り付けた画像の幅取得
        picWidth = Application.WorksheetFunction.RoundUp(Selection.Width / targetCell.Width, 0)
        ' 貼り付けた画像の下にファイル名を記入
        Cells(firstRow, targetCol).Offset(picHeight, 0) = myFileName
        i = i + 1
        ' 指定した列数に達したら、次の行へ行って列を元に戻す
        If i = Range("B1") Then
            firstRow = firstRow + picHeight + 1
            i = 0
        End If
    End If
    myFileName = Dir()
    Loop
    MsgBox "画像の読込みが終了しました"
 End Sub