MS Excel

Téma: Vytvorenie nového priečinku pri uložení

Zaslal/a Zdeno-Frano 27.11.2019 0:13

Dobrý večer.
Mám makro na uloženie súboru do pdf.
Sub Tlac_do_PDF()
Application.ScreenUpdating = True
názov = "ABC"
subor = "C:\Users\XXXXX\Documents\Pracovné\" & názov & ".pdf"
ActiveWorkbook.Save
Sheets(Array("List1")).Select
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=subor, _
Quality:=xlQualityMaximum, IncludeDocProperties:=True, IgnorePrintAreas:=False, _
OpenAfterPublish:=True
Application.ScreenUpdating = True
End Sub
Potreboval by som ale aby sa vždy pri jeho uložení vytvoril v priečinku ,,Pracovné,, podpriečinok s názvom napr.:
názov1 = Sheets("List1").Range("A1").Text
( cesta = "C:\Users\XXXXX\Documents\Pracovné\" & názov1 ),

resp. ak tam už takýto priečinok existuje, aby sa súbor uložil do neho.
Niečo som na nete našiel, ale nedarí sa mi to prispôsobiť. Mohol by mi s tým niekto pomôcť?

Ďakujem

Zaslat odpověď >

elninoslov(27.11.2019 7:22)#045085

EDIT: 27.11.2019 8:16 - výmena prílohy aj kódu - doplnený podpriečinok "Pracovné"
Pr.Sub Tlac_do_PDF()
Dim Nazov As String, Cesta As String, Podpriecinok As String

With ThisWorkbook
.Save
With Worksheets("List1")
Nazov = "ABC"
Podpriecinok = .Range("A1").Value
Cesta = CreateObject("WScript.Shell").SpecialFolders("mydocuments") & "\Pracovné\"
If Len(Dir(Cesta, vbDirectory)) = 0 Then MkDir Cesta
Cesta = Cesta & IIf(Podpriecinok = "", "", Podpriecinok & "\")
If Len(Dir(Cesta, vbDirectory)) = 0 Then MkDir Cesta

.ExportAsFixedFormat Type:=xlTypePDF, Filename:=Cesta & Nazov & ".pdf", _
Quality:=xlQualityMaximum, IncludeDocProperties:=True, IgnorePrintAreas:=False, _
OpenAfterPublish:=True
End With
End With
End Sub

Příloha: zip

45085_pdf-do-podpriecinku.zip (19kB, staženo 22x)

citovat

Zdeno-Frano(27.11.2019 10:04)#045091

Super!!! Veľká vďaka!!citovat

Téma: Vytvorenie nového priečinku pri uložení

Uživatelské menu

Menu

Formulář Faktura

Formulář Faktura IV

Helios iNuvio

On-line nástroje