VBA Alle Bilder aus Ordner sortiert einfügen

Option Explicit
Private Const IMAGE_HEIGHT As Long = 115 'Bildhöhe
Private Const FIRST_IMAGE_TOP As Long = 15 'Startposition von oben
Private Const FIRST_IMAGE_LEFT As Long = 10 'Startposition von links
Private Const SPACE_H As Long = 5 'Horizontaler Abstand
Private Const SPACE_V As Long = 5 'Vertikaler Abstand
Private Const MAX_IMAGES_IN_ROW As Long = 3 'Maximale Bilderanzahl pro Reihe
Sub insertPictures()
Dim objImg As Object
Dim strPath As String, strImg As String
Dim dblTop As Double, dblLeft As Double, dblMaxWidth As Double
Dim lngIndex As Long, lngCalc As Long, hoehe As Long
Dim filelist() As String
Dim folder
On Error GoTo ErrExit
With Application
.ScreenUpdating = False
.EnableEvents = False
lngCalc = .Calculation
.Calculation = xlCalculationManual
.DisplayAlerts = False
End With
hoehe = FIRST_IMAGE_TOP + ActiveCell.Top
dblTop = hoehe
dblLeft = FIRST_IMAGE_LEFT
strPath = fncBrowseForFolder
If Len(strPath) Then
ActiveSheet.Shapes.SelectAll
strPath = strPath & "\"
strImg = Dir(strPath & "*.jpg", vbNormal)
Do While strImg  ""
Set objImg = ActiveSheet.Pictures.Insert(strPath & strImg)
With objImg
.ShapeRange.LockAspectRatio = msoTrue
.Height = IMAGE_HEIGHT
.Left = dblLeft
.Top = dblTop
.ShapeRange.Rotation = 0
lngIndex = lngIndex + 1
dblMaxWidth = Application.Max(dblMaxWidth, .Width)
End With
If lngIndex Mod MAX_IMAGES_IN_ROW = 0 Then
dblTop = dblTop + IMAGE_HEIGHT + SPACE_V
dblLeft = FIRST_IMAGE_LEFT
Else
dblLeft = dblLeft + dblMaxWidth + SPACE_H
dblMaxWidth = 0
End If
strImg = Dir
Loop
End If
ErrExit:
With Err
If .Number  0 Then
MsgBox "Fehler in Prozedur:" & vbTab & "'insertPictures'" & vbLf & String(60, "_") & _
vbLf & vbLf & IIf(Erl, "Fehler in Zeile:" & vbTab & Erl & vbLf & vbLf, "") & _
"Fehlernummer:" & vbTab & .Number & vbLf & vbLf & "Beschreibung:" & vbTab & _
.Description & vbLf, vbExclamation + vbMsgBoxSetForeground, _
"VBA - Fehler in Modul - Modul1"
.Clear
End If
End With
On Error GoTo 0
With Application
.ScreenUpdating = True
.EnableEvents = True
.Calculation = lngCalc
.DisplayAlerts = True
End With
Set objImg = Nothing
End Sub
Private Function fncBrowseForFolder(Optional ByVal defaultPath = "C:") As String
Dim objFlderItem As Object, objShell As Object, objFlder As Object
Set objShell = CreateObject("Shell.Application")
Set objFlder = objShell.BrowseForFolder(0&, "Ordner auswählen...", 0&, defaultPath)
If objFlder Is Nothing Then GoTo ErrExit
Set objFlderItem = objFlder.Self
fncBrowseForFolder = objFlderItem.Path
ErrExit:
Set objShell = Nothing
Set objFlder = Nothing
Set objFlderItem = Nothing
End Function