Option Explicit
 
Dim WithEvents picBig As PictureBox
Dim WithEvents picscroller As HScrollBar
Dim pics As Collection 'Bilddateien
Dim imgLoaded As StdPicture
 
Private Sub Form_Load()
 
Me.ScaleMode = vbPixels
Me.Width = 9000: Me.Height = 9000
Me.ScaleWidth = 600: Me.ScaleHeight = 600
Me.BorderStyle = 1
 
Set picBig = Me.Controls.Add("VB.PictureBox", "PicBig", Me)
Set picscroller = Me.Controls.Add("VB.HScrollbar", "PicScroller", Me)
 
With picscroller
   .Top = 0: .Left = 0: .Width = 590: .Visible = False
End With
With picBig
   .Top = 25: .Left = 5: .Width = 590: .Height = 450
   .ScaleMode = vbPixels
End With
 
Set pics = GetPicFiles("Ordner mit Bildern angeben")
If pics.Count < 1 Then
    MsgBox "Keine Bilddateien im Ordner"
Else
   If pics.Count > 1 Then
      With picscroller
       .Min = 1: .Max = pics.Count: .Value = 1: .Visible = True
      End With
   End If
End If
 
End Sub
 
 
Private Function GetPicFiles(ByVal folderspec As String) As Collection
    'Bilddateien im Ordner ermitteln (BMP, JPG)
    Dim fs, f, f1, fc, piccol As Collection, fn As String
    Set piccol = New Collection
    Set fs = CreateObject("Scripting.FileSystemObject")
    Set f = fs.GetFolder(folderspec)
    Set fc = f.Files
    For Each f1 In fc
        fn = UCase(f1.Name)
        If InStr(fn, ".JPG") > 0 Or InStr(fn, ".BMP") > 0 Then
           Call piccol.Add(f1.Path)
        End If
    Next f1
    Set GetPicFiles = piccol
End Function
 
Private Sub picscroller_Change()
    'Navigieren durch die Liste mit Bilddateien
 
    On Error GoTo fehler
    Dim w%, h%, wp%, hp%
    Set imgLoaded = LoadPicture(pics(picscroller.Value))
    'Bild in Picturebox einpassen
    w% = imgLoaded.Width: h% = imgLoaded.Height
    hp = picBig.Height: wp = w / h * picBig.Height
    If wp > picBig.Width Then
       hp = h / w * picBig.Width: wp = picBig.Width
    End If
 
    With picBig
       .AutoRedraw = True: .Picture = LoadPicture
       Call .PaintPicture(imgLoaded, 0, 0, wp, hp)
       .Picture = .Image: .AutoRedraw = False
       .Visible = True
    End With
fehler:
    Me.Caption = pics(picscroller.Value)
End Sub