automatski thumbnails

Code:

Sub Test()
' Za sve popunjene celije u koloni A
' Dodaje sliku kao hiperlink u koloni B
Dim cl As Range
Dim sh As Worksheet
Dim rw As Long, rwstart As Integer, rwend As Long
Dim path As String
    
    Set sh = ActiveSheet                    ' Uzima se aktivni list
    path = "F:\My Documents\My Pictures\"   ' Ovde zadati folder
    rwstart = 1                             ' Ovde zadati pocetni red
    rwend = sh.Cells(16555, 1).End(xlUp).Row
    sh.Columns(2).ColumnWidth = 13.57       ' Podesava se sirina kolone na 100 piksela
    For rw = rwstart To rwend
      Set cl = ActiveSheet.Cells(rw, 2)
      cl.Rows(1).RowHeight = 75             ' Podesava se visina reda na 100 piksela
      InsertPictureInRange path & cl.Offset(ColumnOffset:=-1).Text & ".jpg", cl
    Next
End Sub

Sub InsertPictureInRange(PictureFileName As String, TargetCells As Range)
' Umece sliku i prilagodjava je velicini odredišne celije
' zatim dodaje Hiperlink
' Prepravljeno sa exceltip.com

Dim p As Object, s As Shape
Dim t As Double, l As Double, w As Double, h As Double
    If TypeName(ActiveSheet) <> "Worksheet" Then Exit Sub
    If Dir(PictureFileName) = "" Then Exit Sub
    ' Umetanje slike
    Set p = ActiveSheet.Pictures.Insert(PictureFileName)
    ' Odredjivanje pozicije
    With TargetCells
        t = .Top
        l = .Left
        w = .Offset(0, .Columns.Count).Left - .Left
        h = .Offset(.Rows.Count, 0).Top - .Top
    End With
    ' Pozicioniranje slike
    With p
        .Top = t
        .Left = l
        .Width = w
        .Height = h
    End With
   ' Kao argument Anchor za hiperlink treba da se prenese shape
    TargetCells.Worksheet.Hyperlinks.Add Anchor:=p.ShapeRange(1), _
             Address:=PictureFileName
    Set p = Nothing
End Sub