■

縦位置が中央揃えでも上詰めでもうまく行くように修正。
下に余分な改行がついていても削除して対応するようにもしようとしたけど、
均等割付の場合うまくいかないのでやめました。

Sub 画像挿入()
    Const picHeight As Double = 100
    Const picWidth As Double = 60
    Const picMargin As Double = 3
    Dim topPoint As Double
    Dim buf As String
    Dim i As Integer
    Dim myShape As Shape
    
    If TypeName(Selection) <> "Range" Then
        MsgBox "画像を挿入するセルを選択してください"
        Exit Sub
    End If
    
    With Application.FileDialog(msoFileDialogFolderPicker)
        If .Show = True Then
            Select Case Selection.VerticalAlignment
                Case -4160
                    Selection.Copy Range("A65536")
                    Rows(65536).AutoFit
                    If Selection.Row = 1 Then
                        topPoint = Rows(65536).Height
                    Else
                        topPoint = Rows("1:" & Selection.Row - 1).Height + Rows(65536).Height
                    End If
                    Rows(65536).Delete
                Case -4108
                    Selection.Copy Range("A65536")
                    Rows(65536).AutoFit
                    If Selection.Row = 1 Then
                        topPoint = (Rows(65536).Height + Selection.Height) / 2
                    Else
                        topPoint = Rows("1:" & Selection.Row - 1).Height + _
                            (Rows(65536).Height + Selection.Height) / 2
                    End If
                    Rows(65536).Delete
                Case Else
                    topPoint = Rows("1:" & Selection.Row).Height
            End Select
            buf = Dir(.SelectedItems(1) & "\*.*")
            Do While buf <> ""
                On Error Resume Next
                Set myShape = ActiveSheet.Shapes.AddPicture(buf, _
                    LinkToFile:=False, SaveWithDocument:=True, _
                    Left:=Selection.Left + (i Mod 3) * (picWidth + picMargin), _
                    Top:=topPoint + Int(i / 3) * (picHeight + picMargin), _
                    Width:=picWidth, Height:=picHeight)
                    If Err.Number = 0 Then
                        i = i + 1
                    End If
                On Error GoTo 0
                buf = Dir()
            Loop
        End If
    End With
End Sub

回答終わっての感想。
う〜ん、最低限動かしてほしかった。
前にも、できたって言っただけでイルカもらった人いたっけな。
わかる人にはわかるから、まあいいか。