habe eben doch noch was im Netz gefunden.

gefunden auf: herber

hab den Pfad noch auf 

strPath = ThisWorkbook.Path

geändert, dann gings!!!

' **********************************************************************
' Modul: Modul1 Typ: Allgemeines Modul
' **********************************************************************

Option Explicit

Private Const IMAGE_HEIGHT As Long = 45 'Bildhöhe
Private Const IMAGE_WIDTH As Long = 175 'Bildbreite
Private Const FIRST_IMAGE_TOP As Long = 15 'Startposition von oben
Private Const FIRST_IMAGE_LEFT As Long = 20 '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_COL As Long = 3 '15 'Maximale Bilderanzahl pro Spalte

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
  
  On Error GoTo ErrExit
  
  With Application
    .ScreenUpdating = False
    .EnableEvents = False
    lngCalc = .Calculation
    .Calculation = xlCalculationManual
    .DisplayAlerts = False
  End With
  
  dblTop = FIRST_IMAGE_TOP
  dblLeft = FIRST_IMAGE_LEFT
  
  strPath = ThisWorkbook.Path
  
  If Len(strPath) Then
    ActiveSheet.Shapes.SelectAll
    Selection.Delete
    strPath = strPath & "\"
    strImg = Dir(strPath & "*.jpg", vbNormal)
    Do While strImg <> ""
      Set objImg = ActiveSheet.Pictures.Insert(strPath & strImg)
      With objImg
        .ShapeRange.LockAspectRatio = msoFalse
        .Height = IMAGE_HEIGHT
        .Width = IMAGE_WIDTH
        .Left = dblLeft
        .Top = dblTop
        lngIndex = lngIndex + 1
        'dblMaxWidth = Application.Max(dblMaxWidth, .Width)
      End With
      If lngIndex Mod MAX_IMAGES_IN_COL = 0 Then
        dblTop = FIRST_IMAGE_TOP
        dblLeft = dblLeft + IMAGE_WIDTH + SPACE_H
        'dblMaxWidth = 0
      Else
        dblTop = dblTop + IMAGE_HEIGHT + SPACE_V
      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 = "") 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