Dobrý den,
mám kód:

ale když ho uložím v PDF vše je v pořádku pak to chci uložit v XLSM a odkaz také funguje ale pokud chci otevřít odkaz na tím tak to nejde otevřít.
Můžete mi prosím kód opravit?
Moc děkuji

' ===== FUNKCE: Úprava textu v C3 na čitelnou formu =====
Function UpravitNadpis(textRaw As String) As String
Dim i As Long, slozeno As String
textRaw = Trim(textRaw)

For i = 1 To Len(textRaw)
If Mid(textRaw, i, 1) <> " " Then
slozeno = slozeno & Mid(textRaw, i, 1)
End If
Next i

If Len(textRaw) > 0 And UBound(Split(textRaw, " ")) >= 4 Then
UpravitNadpis = UCase(Left(slozeno, 1)) & LCase(Mid(slozeno, 2))
Else
textRaw = LCase(textRaw)
UpravitNadpis = UCase(Left(textRaw, 1)) & Mid(textRaw, 2)
End If
End Function

' ===== TLAČÍTKO - hlavní spuštění =====
Sub Tlačítko9_Kliknutí()
Dim cestaKPDF As String
Dim fakturaCislo, jmeno, prijemce, datum, castka, popis

With Sheets("Stvrzenka")
fakturaCislo = .Range("G5").Value
jmeno = .Range("C26").Value
prijemce = .Range("K26").Value
datum = .Range("AM5").Value
castka = .Range("AG19").Value
popis = .Range("J28").Value
End With

cestaKPDF = UlozitSoubor()

If cestaKPDF = "Zruseno" Then Exit Sub

' Volání zápisu do seznamu faktur
Call ZapsatDoSeznamuFakturManual(fakturaCislo, jmeno, prijemce, datum, castka, popis, cestaKPDF)
' Volání funkce pro vymazání s dotazem
Call MazuSVolbou
End Sub

' ===== MAZÁNÍ S DOTAZEM =====
Sub MazuSVolbou()
If MsgBox("Chceš vymazat data a zvýšit číslo faktury?", vbYesNo + vbQuestion) = vbYes Then
With Sheets("Stvrzenka")
.Range("AW17").Value = 0
.Range("G5").Value = .Range("G5").Value + 1
End With
End If
End Sub

' ===== ULOŽENÍ PDF / XLSM / OBOJÍ + náhled tisku =====
Function UlozitSoubor() As String
Dim volba As String, Cas As String
Dim cestaPDF As String, cestaXLSM As String
Dim FinalName As String
Dim CestaS As String: CestaS = "E:\" ' Nastavte výchozí cestu
Dim ws As Worksheet: Set ws = Sheets("Stvrzenka")

FinalName = Trim(ws.Range("O9").text) & " - " & Trim(ws.Range("G5").text)

' Zobrazení formuláře pro volbu formátu
On Error Resume Next
UserForm1.Tag = ""
UserForm1.Show
volba = UserForm1.Tag
On Error GoTo 0

If volba = "Zrusit" Or volba = "" Then
UlozitSoubor = "Zruseno"
Exit Function
End If

' Uložení do PDF
If volba = "PDF" Or volba = "Obe" Then
cestaPDF = CestaS & FinalName & ".pdf"
If Dir(cestaPDF) <> "" Then
Cas = Format(Now, "dd.mm.yyyy - HH.MM.SS")
cestaPDF = CestaS & FinalName & " - " & Cas & ".pdf"
End If
ws.ExportAsFixedFormat Type:=xlTypePDF, Filename:=cestaPDF, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
End If

' Uložení do XLSM
If volba = "XLSM" Or volba = "Obe" Then
cestaXLSM = CestaS & FinalName & ".xlsm"
If Dir(cestaXLSM) <> "" Then
Cas = Format(Now, "dd.mm.yyyy - HH.MM.SS")
cestaXLSM = CestaS & FinalName & " - " & Cas & ".xlsm"
End If
ThisWorkbook.SaveCopyAs Filename:=cestaXLSM
End If

' Tiskový náhled (pokud je požadováno)
If MsgBox("Chceš zobrazit náhled před tiskem?", vbYesNo + vbQuestion, "Náhled tisku") = vbYes Then
ws.PrintPreview
End If

' Výběr cesty k souboru
If cestaPDF <> "" And Dir(cestaPDF) <> "" Then
UlozitSoubor = cestaPDF
ElseIf cestaXLSM <> "" And Dir(cestaXLSM) <> "" Then
UlozitSoubor = cestaXLSM
Else
UlozitSoubor = ""
End If
End Function

' ===== ZÁPIS DO SEZNAMU FAKTUR S FUNKČNÍM ODKAZEM =====
Sub ZapsatDoSeznamuFakturManual(fakturaCislo, jmeno, prijemce, datum, castka, popis, cestaPDF As String)
Dim ws As Worksheet: Set ws = ThisWorkbook.Sheets("Seznam faktur")
Dim r As Long, radek As Long, nalezeno As Boolean
Dim cistyText As String, zobrazenyText As String, vzorec As String
Dim existujiciOdkaz As String

For r = 2 To ws.Cells(ws.Rows.Count, 1).End(xlUp).Row
If ws.Cells(r, 1).Value = fakturaCislo Then
radek = r: nalezeno = True: Exit For
End If
Next r
If Not nalezeno Then radek = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row + 1

cistyText = UpravitNadpis(Sheets("Stvrzenka").Range("C3").text)
zobrazenyText = cistyText & " " & Sheets("Stvrzenka").Range("G5").text

If ws.Cells(radek, 8).Hyperlinks.Count > 0 Then
existujiciOdkaz = ws.Cells(radek, 8).Hyperlinks(1).Address
End If

With ws
.Cells(radek, 1).Value = fakturaCislo
.Cells(radek, 2).Value = jmeno
.Cells(radek, 3).Value = prijemce
.Cells(radek, 4).Value = datum
.Cells(radek, 5).Value = castka
.Cells(radek, 6).Value = popis

' Opravený vzorec pro "Zaplaceno" při platbě "Hotově"
vzorec = "=KDYŽ(NEBO(A" & r & "<>"""";F" & r & "=""Hotově"");""Zaplaceno: "" &HODNOTA.NA.TEXT(D" & r & ";""dd.mm.rrrr"");"""")"
.Cells(r, 7).FormulaLocal = vzorec

' ===== Hyperlink zápis – vždy správně =====
.Cells(radek, 8).Value = ""

If cestaPDF <> "" And Dir(cestaPDF) <> "" Then
.Hyperlinks.Add Anchor:=.Cells(radek, 8), Address:=cestaPDF, TextToDisplay:=zobrazenyText
ElseIf existujiciOdkaz <> "" Then
.Hyperlinks.Add Anchor:=.Cells(radek, 8), Address:=existujiciOdkaz, TextToDisplay:=zobrazenyText
Else
.Cells(radek, 8).Value = zobrazenyText
End If

With .Cells(radek, 8).Font
.color = RGB(0, 0, 0)
.Underline = xlUnderlineStyleNone
End With
End With

' Jedna zpráva po úspěšném uložení souboru a zápisu do seznamu faktur
MsgBox "Soubor byl uložen a zapsán do seznamu faktur."
End Sub