Automatické vkládání hypertextových odkazů Vyřešeno

[NechodimDomu]

Zdravím všechny,

Můj úkol je následující:
Potřebuji do tabulky vkládat hypertextové odkazy na objednávky v .pdf uložené na serveru a to je často zdlouhavá operace, při které se člověk snadno překlikne.

Můj problém je následující:
Pokaždé když kliknu pravím myšítkem a zvolím možnost "hypertextový odkaz" objeví se obrazovka s umístěním souboru, která odkazuje na složku kde je uložen .xlsx soubor který zrovna upravuji, ale složka s objednávkami je jinde na serveru a pokaždé se k ní musím dostat proklikáním nebo přímím napsáním cesty k souboru, což není zrovna rychlovkou a opravdu to unavuje oči i mozek. Nikde jsem nenašel funkci, že by záložku na složku s objednávkami šlo uložit do rychlé volby abych ji nemusel pořád pracně vyhledávat...

Moje představa je následující:
Představoval jsem si (uplně v nejlepším případě), že bych měl v buňce napsáné číslo objednávky (zadám samosebou ručně), které by po kliknutí na makro vyhledalo stejný název souboru, jako je název objednávky v právě označené buňce, ve složce s objednávkami a přiřadilo na ní hypertextový odkaz.

Makrům moc nerozumým, i když si myslím, že nejde o nic zrovna moc složitého, ale nejsem do nich zasvěcen a neznám příkazy v nich používané. Tudíž žádám někoho zběhlejšího o radu, jak toto makro nastavit nebo zkusit něco podobně funkčního.

Předem děkuji za radu.

PS: Podobný problém jsem na fóru nenašel a tak zakládám nový příspěvek.

[Reklama]

[cmuch]

Tady je makro které vlož do modulu listu.
Uprav cestu a sloupec ve kterém budou ty názvy pdf ("E:E")

Kód: Vybrat vše

Private Sub Worksheet_Change(ByVal Target As Range)

  Dim strPathPdf As String

  strPathPdf = "cesta ke slozce\" 'musi končit zavorkou

  If Not Application.Intersect(Range("E:E"), Target) Is Nothing Then
    Target.Hyperlinks.Add _
        Anchor:=Target, _
        Address:=strPathPdf & Target.Value & ".pdf", _
        TextToDisplay:=Target.Value
  End If
End Sub

[NechodimDomu]

Děkuji moc za odezvu.

Chvilku mě trvalo, než sem měl čas makro aplikovat, ale dnes jsem se k tomu dostal a nedokázal jsem ho dostat do funkčního stavu.

Testoval jsem to na souboru ve složce C:\pokus\2016.pdf

Upravil jsem 2 řádky:

strPathPdf = "C:\pokus\"
If Not Application.Intersect(Range("B:B"), Target) Is Nothing Then

Buňku mám vždy ve sloupci B. Zkušel jsem zadat i B2:B5000.

pak jsem napsal do buňky (někde v sloupci B) 2016 a použil makro.
Objevila se hláška: Argument not optional

Jinak to makro vypadá, že by mohlo fungovat, spíše si myslím, že já dělám někde chybu.
Taky jsem neporuzuměl části "...Target.Value..." myslel sem, že by mohla být chyba někde u této části, tak sem zkoušel napsal pouze ...Target..., ale samozřejmě bez úspěchu.

Za další radu bud velice rád.

[cmuch]

tak pouprav takto

Kód: Vybrat vše

Private Sub Worksheet_Change(ByVal Target As Range)

  Dim strPathPdf As String

  strPathPdf = "cesta ke slozce\" 'musi končit lomitkem

  If Not Application.Intersect(Range("E:E"), Target) Is Nothing Then
    On Error Resume Next
    Target.Hyperlinks.Add _
        Anchor:=Target, _
        Address:=strPathPdf & Target.Value & ".pdf"
    On Error GoTo 0
  End If
End Sub

[NechodimDomu]

Tohle makro už je mnohem lepší. :)

Můžu říct, že to funguje... Za to moc děkuji.

Nicméně má to nějakou tu mouchu... Když text v buňce smažu zapíše to do ní:
"file://C:\pokus\file:\\C:\pokus\file:\\C:\pokus\file:\\C:\pokus.........pdf.pdf.pdf.pdf.pdf.pdf.pdf.pdf.pdf"
(je to tam asi 50krát, nebudu to celé kopírovat)

Dál mě překvapuje, že nefunguje tlačítko zpět po tom co do buňky zapíšu text. Je to normální?

Co mě ale potěšilo je, že když přepíšu cílovou složku na jinou, tak dříve zapsané buňky odkazují na složku původní, to je pro mne důležité.

Jinak zatím vše OK, na první vyzkoušení.

[cmuch]

Bohužel zpět nebude fungovat po použití makra, které něco zapisuje do sešitu

Kód: Vybrat vše

Private Sub Worksheet_Change(ByVal Target As Range)

  Dim strPathPdf As String

  strPathPdf = "cesta ke slozce\" 'musi končit lomitkem
 
  If Not Application.Intersect(Range("E:E"), Target) Is Nothing Then
    Application.EnableEvents = False
    On Error Resume Next
    If Target <> "" Then 'prida HT
      Target.Hyperlinks.Add _
        Anchor:=Target, _
        Address:=strPathPdf & Target.Value & ".pdf"
    Else
      Target.Hyperlinks.Delete 'smaze HT
    End If
    On Error GoTo 0
    Application.EnableEvents = True
  End If
End Sub

[NechodimDomu]

Makro funkční, děkuji velice moc za pomoc. Téma uzamykám, kdyby se něco objevilo, napíšu SZ.

THX