Dobrý den,
mám problém. Mám cca 30 listů v excelu a potřeboval bych je uložit do pdf. každý zvlášť a pojmenovat podle názvu listu nebo bunky "CC1" ( mají stejný název to je jedno)
Nemohl by mi někdo poradit ?
Sub Makro1()
'
' Makro1 Makro
'
a = Range("CC1").Text
soubor = "C:\Users\uid40697\Desktop\Action corner_makro\test\" & a & ".pdf"
ActiveWorkbook.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
soubor, Quality:= _
xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, _
OpenAfterPublish:=False
'
End Sub
tohle mi píše že soubor není uložen. Přitom je přímo ve stejném adresáři.
Excel - makro na uložení sešitu Vyřešeno
- elninoslov
- Level 2.5
- Příspěvky: 366
- Registrován: červen 13
- Pohlaví:
- Stav:
Offline
Re: Excel - makro na uložení sešitu
Problémom je zapisovanie do systémového adresára na systémovom disku. Ak to dáte na iný disk ide to OK. Máte právo zapisovať tomu užívateľovi na plochu?
Kód: Vybrat vše
Sub ExportListsToSeparatedPDFs()
Dim WS As Worksheet, Path As String
Path = "D:\Users\uid40697\Desktop\Action corner_makro\test\"
For Each WS In ThisWorkbook.Worksheets
WS.ExportAsFixedFormat Type:=xlTypePDF, Filename:=Path & WS.Name & ".pdf", Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
Next WS
Set WS = Nothing
End Sub
Re: Excel - makro na uložení sešitu
Práva k zápisu mám.... Jsem Administrátor.
prepsal jsme to tedy na disk D:\ podle vašeho skriptu, ale buhužel stále nefunguje.
Chyba Run-time error '1004':
Dokument nebyl uložen. Možné příčiny: Dokument je otevřen nebo došlo při ukládání k chybě.
A zažlutí mi:
WS.ExportAsFixedFormat Type:=xlTypePDF, Filename:=Path & WS.Name & ".pdf", Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
sešit jsem samozřejmě uložil po úpravě makra.
Dodatečně přidáno po 16 minutách 46 vteřinách:
Omlouvám se už funguje.
Na D:\ nebyl vytvořen adresář. Po vytvoření krásně publikuje každý list zvlášť do pdf.
Děkuji moc.
Jen mě ještě napadlo byl by problém kdyby každý list zapisoval do svoji složky ? se stejným názvem dle listu ?
Př.
D:\Action corner_makro\List1\list1.pdf
D:\Action corner_makro\List2\list2.pdf
prepsal jsme to tedy na disk D:\ podle vašeho skriptu, ale buhužel stále nefunguje.
Chyba Run-time error '1004':
Dokument nebyl uložen. Možné příčiny: Dokument je otevřen nebo došlo při ukládání k chybě.
A zažlutí mi:
WS.ExportAsFixedFormat Type:=xlTypePDF, Filename:=Path & WS.Name & ".pdf", Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
sešit jsem samozřejmě uložil po úpravě makra.
Dodatečně přidáno po 16 minutách 46 vteřinách:
Omlouvám se už funguje.
Na D:\ nebyl vytvořen adresář. Po vytvoření krásně publikuje každý list zvlášť do pdf.
Děkuji moc.
Jen mě ještě napadlo byl by problém kdyby každý list zapisoval do svoji složky ? se stejným názvem dle listu ?
Př.
D:\Action corner_makro\List1\list1.pdf
D:\Action corner_makro\List2\list2.pdf
- elninoslov
- Level 2.5
- Příspěvky: 366
- Registrován: červen 13
- Pohlaví:
- Stav:
Offline
Re: Excel - makro na uložení sešitu
Tak použite takéto niečo:
EDIT 6.6.2020 8:28 : Pridal som 1 riadok kódu aby vypísalo správu ak niektorý adresár nebolo možné vytvoriť.
Kód: Vybrat vše
Sub ExportListsToSeparatedPDFs()
Dim WS As Worksheet, Path As String, wsPath As String, ErrCount As Integer
Path = "D:\Users\uid40697\Desktop\Action corner_makro\test\"
For Each WS In ThisWorkbook.Worksheets
wsPath = Path & WS.Name & "\"
If Create_Dir_Structure(wsPath) Then
WS.ExportAsFixedFormat Type:=xlTypePDF, Filename:=wsPath & WS.Name & ".pdf", Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
Else
ErrCount = ErrCount + 1
End If
Next WS
If ErrCount > 0 Then MsgBox "Některé adresáře (" & ErrCount & ") nebyli vytvořené !", vbCritical, "ERROR !"
Set WS = Nothing
End Sub
Kód: Vybrat vše
Function Create_Dir_Structure(D As String) As Boolean
Dim S() As String, i As Byte, Path As String
If Len(D) < 3 Then Exit Function
S = Split(D, "\")
If UBound(S) = 0 Then Exit Function
Path = S(0)
On Error GoTo KONIEC
For i = 1 To UBound(S)
Path = Path & "\" & S(i)
If Len(Dir(Path, vbDirectory)) = 0 Then MkDir Path
Next i
KONIEC:
Create_Dir_Structure = Err.Number = 0
End Function
EDIT 6.6.2020 8:28 : Pridal som 1 riadok kódu aby vypísalo správu ak niektorý adresár nebolo možné vytvoriť.
- Přílohy
-
- Export listov do samostatných PDF.xlsm
- (22.23 KiB) Staženo 46 x
-
- Mohlo by vás zajímat
- Odpovědi
- Zobrazení
- Poslední příspěvek
-
- 9
- 1111
-
od mmmartin
Zobrazit poslední příspěvek
29 srp 2023 16:47
-
- 16
- 5993
-
od mirekol
Zobrazit poslední příspěvek
20 říj 2023 08:31
-
- 1
- 266
-
od Grimm
Zobrazit poslední příspěvek
12 bře 2024 21:43
-
- 3
- 1841
-
od Story-Long
Zobrazit poslední příspěvek
14 srp 2023 10:11
-
- 2
- 1641
-
od honzzicek
Zobrazit poslední příspěvek
01 črc 2023 08:57
Kdo je online
Uživatelé prohlížející si toto fórum: Žádní registrovaní uživatelé a 7 hostů