Excel - makro na uložení sešitu Vyřešeno

Programy pro práci v kanceláři (Word, Excel, Access…=>Office)

Moderátor: Mods_senior

kulda_5
nováček
Příspěvky: 2
Registrován: červen 20
Pohlaví: Muž

Re: Excel - makro na uložení sešitu

Příspěvekod kulda_5 » 02 čer 2020 14:12

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.



Reklama
Uživatelský avatar
elninoslov
Level 2.5
Level 2.5
Příspěvky: 260
Registrován: červen 13
Pohlaví: Muž

Re: Excel - makro na uložení sešitu

Příspěvekod elninoslov » 02 čer 2020 22:30

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

kulda_5
nováček
Příspěvky: 2
Registrován: červen 20
Pohlaví: Muž

Re: Excel - makro na uložení sešitu

Příspěvekod kulda_5 » 03 čer 2020 08:48

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

Uživatelský avatar
elninoslov
Level 2.5
Level 2.5
Příspěvky: 260
Registrován: červen 13
Pohlaví: Muž

Re: Excel - makro na uložení sešitu

Příspěvekod elninoslov » 05 čer 2020 11:17

Tak použite takéto niečo:

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ť.
Nemáte oprávnění prohlížet přiložené soubory.


  • Mohlo by vás zajímat
    Odpovědi
    Zobrazení
    Poslední příspěvek
  • Excel - porovnávání dat v listech jednoho sešitu
    od Joselinne » 01 pro 2019 21:04 » v Kancelářské balíky
    0
    629
    od Joselinne
    01 pro 2019 21:04
  • Excel - rozklikávací seznam v buňce nefunguje po odeslání/uložení souboru
    od Radkli » 14 srp 2019 16:25 » v Kancelářské balíky
    3
    1523
    od guest
    21 říj 2019 10:32
  • makro excel
    od pajdaj » 08 dub 2020 09:09 » v Kancelářské balíky
    4
    466
    od pajdaj
    09 dub 2020 07:24
  • Excel vzorec/makro?
    od chytilji » včera, 10:37 » v Kancelářské balíky
    2
    84
    od chytilji
    před 10 minutami
  • Excel - makro na sledování změny v buňce
    od Joselinne » 04 lis 2019 20:57 » v Kancelářské balíky
    0
    843
    od Joselinne
    04 lis 2019 20:57

Zpět na “Kancelářské balíky”

Kdo je online

Uživatelé prohlížející si toto fórum: CommonCrawl [Bot] a 1 host