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