Excel uložení sešitu v PDF

Dobrý den,
chtě bych se zeptat a radu.
Mám sešit v Excelu Šablona aplikace Excel s podporou maker.
kód:
Sub Save()

' Save souboru s kontrolou zda soubor existue
Dim Umisteni As String
Dim Hlaska As Byte
' uzivatel = Application.UserName

JmenoS = Sheets("Stvrzenka").Range("G5").Text 'Názve souboru
JmenoST = Sheets("Stvrzenka").Range("O9") ' Text z C3 - Stvrzenka
CestaS = "D:\" ' tu s přepiš cestu kam chceš
Umisteni = CestaS & JmenoST & " - " & JmenoS & ".pdf" 'přídán text z Bunky C3 a -

If Dir(Umisteni) = "" Then
JmenoS = Sheets("Stvrzenka").Range("G5").Text 'Názve souboru
JmenoST = Sheets("Stvrzenka").Range("O9") ' Text z C3 - Stvrzenka
CestaS = "D:\" ' tu s přepiš cestu kam checš

'Save Exel
'ThisWorkbook.SaveCopyAs Filename:=CestaS & JmenoST & " - " & JmenoS & ".xlsm" 'přídán text z Bunky C3 a -

'Save do PDF
ActiveWorkbook.Save
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=CestaS & JmenoST & " - " & JmenoS & ".pdf" _
, Quality:=xlQualityStandard, _
IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:= _
False

Else
JmenoS = Sheets("Stvrzenka").Range("G5").Text 'Názve souboru
JmenoST = Sheets("Stvrzenka").Range("O9") ' Text z C3 - Stvrzenka
CestaS = "D:\" ' tu s přepiš cestu kam chceš pokut soubor existue
Umisteni = CestaS & JmenoST & " - " & ".xlsm" 'přídán text z Bunky C3 a -
Cas = JmenoST & " - " & JmenoS & " - " & Format(Now, "hh.mm") 'přidá se čas pokud soubor se stejným názvem existue

'Save Exel
'ThisWorkbook.SaveCopyAs Filename:=CestaS & Cas & ".xlsm"

'Save do PDF
ActiveWorkbook.Save
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=CestaS & Cas & ".pdf" _
, Quality:=xlQualityStandard, _
IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:= _
False

End If

Call Mazání ' pustí makro na rozhodování mazání

End Sub

Sub Mazání()

e = MsgBox("Chceš údaje z stvrzenky " & Range("G5") & " smazat ?", vbYesNo)

Select Case e

Case vbNo

Case vbYes

Range("AR9:AS9").Select
ActiveCell.FormulaR1C1 = "0" ' přenastaví hodnotu na nula aby se udaje smazali
Range("AR10").Select

JmenoS = Sheets("Stvrzenka").Range("G5").Value + 1 'Názve souboru
Range("G5") = JmenoS ' změní čílo o 1 vetší

End Select

End Sub

Sub tlačítko3_Kliknutí()
' Save souboru s kontrolou zda soubor existue
Dim Umisteni As String
Dim Hlaska As Byte
' uzivatel = Application.UserName

JmenoS = Sheets("Stvrzenka").Range("G5").Text 'Názve souboru
JmenoST = Sheets("Stvrzenka").Range("O9").Text ' Text z C3 - Stvrzenka
CestaS = "D:\" ' tu s přepiš cestu kam chceš
Umisteni = CestaS & JmenoST & " - " & JmenoS & ".xlsm" 'přídán text z Bunky C3 a -

If Dir(Umisteni) = "" Then
JmenoS = Sheets("Stvrzenka").Range("G5").Text 'Názve souboru
JmenoST = Sheets("Stvrzenka").Range("O9").Text ' Text z C3 - Stvrzenka
CestaS = "D:\" ' tu s přepiš cestu kam checš
ThisWorkbook.SaveCopyAs Filename:=CestaS & JmenoST & " - " & JmenoS & ".xlsm" 'přídán text z Bunky C3 a -
Else
JmenoS = Sheets("Stvrzenka").Range("G5").Text 'Názve souboru
JmenoST = Sheets("Stvrzenka").Range("O9").Text ' Text z C3 - Stvrzenka
CestaS = "D:\" ' tu s přepiš cestu kam chceš pokut soubor existue
Umisteni = CestaS & JmenoST & " - " & ".xlsm" 'přídán text z Bunky C3 a -
Cas = "Stvrzenka " & JmenoS & "-" & Format(Now, "hh.mm") 'přidá se čas pokud soubor se stejným názvem existue
ThisWorkbook.SaveCopyAs Filename:=CestaS & Cas & ".xlsm"
End If

Call Mazání ' pustí makro na rozhodování mazání

End Sub

Aby se mi to uložilo v PDF nebo Excelu jenomže mi to na výše uvedeném řádku ukazuje chybu.
Když chci uložit přímo do PDF vyskočí mi tabulka viz příloha.
Děkuji za pomoc