[ Boboje @ 25.12.2008. 10:53 ] @
potrebna mi je pomoc oko jednog makroa. imam dve kolone u excelu. prva sadrzi redove sa tekstom. u pitanju su nazivi filmova, a u drugoj bih zeleo da automatski ubacim omote u istom redu gde je i naziv filma. znaci makro mora da procita tekst iz celije recimo A10 a zatim da u odredjenom folderu na hard disku potrazi .jpg fajl istog naziva kao i tekst iz celije A10 i da ubaci tu sliku u celiju B10 i uradi resize da visina bude 100 piksela naprimer. zatim makro mora da predje na sledeci red sve dok ima teksta. i ako je moguce da napravi hyperlink do originalne slike u folderu, tako da se klikom na malu sliku otvara veca. valjda me razumete. vec imam nesto slicno. imam makro koji cita tekst i ubacuje linkove do slika, ali hteo bih da imam i thumbnails. :). taj makro mi je davno neko uradio ovde na forumu pa se nadam da ce se opet naci neko da pomogne. sta da radim kad ne znam da programiram
[ Jpeca @ 25.12.2008. 14:35 ] @
Preuzeo sam i doterao rutinu koja umece sliku u celiju. Zatim se ta rutina poziva u petji za sve popunjene celije iz kolone A

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


[ Boboje @ 26.12.2008. 12:29 ] @
hvala puno. provericu kasnije
[ chik @ 17.05.2015. 21:46 ] @
Probao sam ovu rutinu ali kod mene "ne radi"!?
Ne znam gde grešim. Ako može neko da mi pomogne na malom primeru?

Hvala unapred!
[ Jpeca @ 18.05.2015. 09:11 ] @
Nisi objasni šta se dešava, odnosno zašto ne radi
1/ Napravio sam folder C:\SLIKE i u njega stavio fajlove Slika1.jpg i Slika2.jpg. Naziv foldera može se promeniti u kodu (vidi komentar u kodu). Eksenzija se uzima jpg a i to me može podesiti u kodu po potrebi
2/ Na listu Sheet1 Alt+F8 startovao sam se makro Test
3/ Makro je završio bez greške. U koloni B dodate su dve slike, i podešena visina i širina ćelije na 100 px. ( U kodu je moguće zadati)



Ne znam da li je to što tebi treba i u čemu je problem.

[ chik @ 18.05.2015. 09:57 ] @
U čemu je bio problem zaista ne znam.
Sada sam probao na drugom računaru (laptop) i sve je OK, sve radi!

Hvala!
[ SeriousMX @ 01.08.2015. 14:26 ] @
Ova skripta ne radi na Excel 2013 nakon što se fajl prenese na drugi računar. Izgleda da je nešto izmjenjeno u Excel 2013, uglavnom ne radi. Ako ko zna rešenje, bio bih zahvalan.
[ dreambox700 @ 24.02.2019. 10:22 ] @
Ima li neko resenje za slicnu stvar u Word-u?
[ bokinet @ 24.02.2019. 13:48 ] @
Sta je konkretan problem?
Opis potreban, uzorci koda i primeri pozeljni (sta nije u f-ji i sta nije ispravno).