Vzorec VBA

si to oddebuguj, ne?
BTW, pokud je v C3 text, nedává smysl použít metodu .text, ale postačí .value

díky

Ještě dotaz tento kód nejde

=KDYŽ(H1<>"";"SPD*1.0*ACC:CZ2755000000000084966004*AM:" & NAHRADIT(TEXT(I1;"0,00");",";"." ) & "*CC:CZK*X-VS:" & H1 & "*MSG:" & H6;"")

Můžete mi prosím poradit kde je chyba?

Děkuji

=KDYŽ(H1<>"";"SPD*1.0*ACC:CZ2755000000000084966004*AM:"&DOSADIT(HODNOTA.NA.TEXT(I1;"0,00");",";".")&"*CC:CZK*X-VS:"&H1&"*MSG:"&H6;"")

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

Jak to ukládáš v PDF?

Dá se to uložit jak v PDF tak i XLSM ale pokud to uložím XLSM už nejde otevřít odkaz nad tím uložením XLSM.
Pokud zase uložím v PDF mohu to otevřít ale výše co již bylo uloženo nejde otevřít odkaze vše se ukládá do E:

Nějak nechápu, asi to přenechám někomu chytřejšímu.

Ukládám to do složky a to jak v PDF tak i XLSM ale když uložím PDF funguje to ale jak to uložím do XLSM tak tonahoře přepíše cestu toho odkazu.
Viz obrázek

Co mám vidět na tom obrázku?

Posílám vzor v Excelu

A keď Ti niekto poradí, ani si nedáš námahu sa k tomu vyjadriť alebo poďakovať...

Nefunguje. Používat diakritiku není zrovna dobrý nápad.

V tom to není. Odstranil sem i všechny ostatní moduly (kdyby byl problém tam) a chyba se stále opakuje.

Však já netvrdil, že mu to nefunguje kvůli diakritice. Ale na mém stroji ta diakritika vadí. Možná kvůli anglickém systému a Excelu. Takže jsem to ani nemohl vyzkoušet.

Tak to vypadá, že chyba je v nastavení Excelu viz:
why-do-my-hyperlinks-in-excel-change-to-a-roaming-folder

U mě pomohlo změnit nastavení z odkazu

1. V Excelu otevřete nabídku Soubor a vyberte možnosti
2. V možnostech vyberte „Upřesnit“. Přejděte dolů do sekce Obecné
3. Vyberte tlačítko 'Možnosti webu'
4. V dialogovém okně Možnosti webu vyberte kartu 'Soubory'
5. Zrušte výběr možnosti 'Aktualizovat odkazy při uložení'.