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

[kulda_5]

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]

[elninoslov]

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]

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

[elninoslov]

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ť.