Macro za spremanje putanje do fajla

[ jaskojsako @ 08.02.2017. 20:57 ] @

Pozdrav
da li postoji mogucnost da pri odabiru fajla za import
u ovome slucaju JPEG format,da umjesto da importuje sliku u excel radni list
da macro zabiljezi putanju do fajla i da ga spremi kao neku vrstu hyperlinka
i da svaki sljedeci insertuje u sljedeci prazan red ako se vise unosi fajlova
Nadam se da sam bio jasan
Hvala unaprijed

[ Ivek33 @ 09.02.2017. 14:59 ] @

Ako imaš nazive files u stupcu u nekom folderu tada možeš iskoristiti ovu formulu

Code:
=IF(A2>0;HYPERLINK("C:\Users\Korisnik\Downloads\"&A2&".jpg";A2);"")

Dakle naziv file bez extenzije nalazi se u A2

Ako Želiš sam odabrati neki folder tada možeš korisiti VBA sa ovog linka.

[ jaskojsako @ 11.02.2017. 23:15 ] @

Hvala Ivek ali nisam na to mislio

Ovaj kod mi odradjuje ali moram kliknuti na celiju
pa tek onda mi napravi putanju i tako svaki put
kad želim da mi napravi putanju do fajla,
a mislio sam da snima link jedan ispod drugog

Kod

Code:

Dim lngCount As Long
Dim cl As Range

Set cl = Range ("A10")
' Open the file dialog
With Application.FileDialog(msoFileDialogOpen)
.AllowMultiSelect = True
.Show
' Display paths of each file selected
For lngCount = 1 To .SelectedItems.Count
' Add Hyperlinks
cl.Worksheet.Hyperlinks.Add _
Anchor:=cl, Address:=.SelectedItems(lngCount), _
TextToDisplay:=.SelectedItems(lngCount)
' Add file name
'cl.Offset(0, 1) = _
' Mid(.SelectedItems(lngCount), InStrRev(.SelectedItems(lngCount), "\") + 1)
' Add file as formula
cl.Offset(0, 1).FormulaR1C1 = _
"=TRIM(RIGHT(SUBSTITUTE(RC[-1],""\"",REPT("" "",99)),99))"

Set cl = cl.Offset(1, 0)
Next lngCount
End With

Ovdje bi trebalo izmjeniti kod da snima jedan ispod drugog putanju

Code:

[ Ivek33 @ 12.02.2017. 07:42 ] @

Koliko ja vidim ovaj VBA radi na slijedeći način

- izbor foldera
- selektiranje datoteke
- rezultat je hiperlink i ime datoteke

Što je problem označiti više datoteka odjednom u folderu?
Na ovaj način imaš sve hiperlinkove importirane u jednom potezu.

[ Ivek33 @ 13.02.2017. 07:19 ] @

Nisam vičan VBA programiranju ali evo "iskemijao" sam nešto jer me zanimalo kako riješiti problem, pa sam preradio tvoj VBA. Vidi da li ti odgovara.
Ovaj VBA radi tako što insertira putanju do datoteke u folderu i to u prvu praznu ćeliju u stupcu 'A' (koju izabereš preko browse folder/file)
Svaki slijedeći insert postavlja putanju u slijedeću prvu praznu ćeliju. Automatski kreira hiperlink i na osnovu tvoje formule vrši extract naziva datoteke u stupcu B. Vidi prikačeni file

btw: vjerujem da vba experti to mogu rješiti jednostavnije :)

[ Jpeca @ 13.02.2017. 10:19 ] @

Da bi Ivekov kod mogao da se koristi za više selektovanih fajlova u dijalogu treba samo postaviti u petlji For lngCount ... da se pređe na sledeću ćeljiu na kraju

Sredio sam malo i početak da se selektuje prva prazna ćelija u koloni A - krećem od kraja i stavio sam 15000 redova kao nešto što će sigurno biti prazno ali možeš lako da promeniš

Code:

Sub InsertBrowsedFilePathAsHyperlinkInFirstBlankCell()

Dim lngCount As Long
Dim cl As Range

Set cl = Range("A15000").End(xlUp).Offset(1, 0) ' Set first empty cell in A column

' Open the file dialog
With Application.FileDialog(msoFileDialogOpen)
    .AllowMultiSelect = True
    .Show
        ' Display paths of each file selected
        For lngCount = 1 To .SelectedItems.Count
            ' Add Hyperlinks
            cl.Worksheet.Hyperlinks.Add _
            Anchor:=cl, Address:=.SelectedItems(lngCount), _
            TextToDisplay:=.SelectedItems(lngCount)
                ' Add file name via formula
                cl.Offset(0, 1).FormulaR1C1 = _
                "=TRIM(RIGHT(SUBSTITUTE(RC[-1],""\"",REPT("" "",99)),99))"
            Set cl = cl.Offset(1, 0)  ' Dodato za prelazak u sledeći red
        Next lngCount
End With
End Sub

[ jaskojsako @ 16.02.2017. 22:22 ] @

Hvala iveku i jpeca

Oba koda odgovaraju.
LP