Makro um aus einer Dropdownliste zwei variable Arbeitsblätter als ein PDF zu exportieren

  • Excel

Es gibt 6 Antworten in diesem Thema. Der letzte Beitrag () ist von inrid.

    Makro um aus einer Dropdownliste zwei variable Arbeitsblätter als ein PDF zu exportieren

    Hallo zusammen,

    ich benötige eure Hilfe. Ich habe eine Arbeitsmappe mit 6 Arbeitsblättern und will ein Makro schreiben um auf Klick alle 29 Einheiten aus der Dropdownliste als PDF's in einen Ordner zu exportieren. Für eine Einheit aus der Dropdownliste müssen immer zwei Arbeitsblätter kombiniert werden.

    Mein bisheriger Code sieht so aus:

    Sub printPDFs()

    Const fileRef = "B1" 'export Folder Name
    Const title = "A1" 'title fo PV plant
    Dim exportFolder As String 'name of folder to store files
    Dim exportName As String 'name of file to export
    Dim PVplant As String
    Dim i As Integer 'loop-counter
    Dim ll As Integer 'length of list


    'obtain folder name for storage and create if it doesn't exist
    exportFolder = Sheets("Lists").Range(fileRef).Value


    ' initialize
    Sheets("pant_monthly" , "daily_overview").Select
    i = 2

    ' loop all PVplants
    While ((Len(Sheets("Lists").Cells(i, 1).Value) > 0) And (i < 1000))
    'read name of PV plant
    PVplant = Sheets("Lists").Cells(i, 1).Value
    Range(title).Value = PVplant

    ' kick out forbidden symbols
    PVplant = Replace(PVplant, "/", "")
    exportName = exportFolder & "\" & PVplant
    exportName = Replace(exportName, Chr(10), "")
    exportName = Replace(exportName, Chr(34), "-")
    ' store pdf
    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=exportName, _
    Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas _
    :=False, OpenAfterPublish:=False
    i = i + 1
    Wend

    End Sub

    Kann mir hier jemand helfen??

    LG

    inrid schrieb:

    alle 29 Einheiten aus der Dropdownliste als PDF's ... exportieren. Für eine Einheit ... müssen immer zwei Arbeitsblätter kombiniert werden
    Deine Exporte bestehen also aus jeweils zwei Arbeitsblättern?
    Da wird es das einfachste sein, du kopierst die jeweiligen Sheets in jeweils ein neues (temporäres) Workbook und wendest darauf ein Workbook.ExportAsFixedFormat an.
    --
    If Not Program.isWorking Then Code.Debug Else Code.DoNotTouch
    --

    inrid schrieb:

    Wie müsste der neue Code aussehen um das Ding zum Laufen zu bringen?
    Weiss ich nicht.
    Und ich mache mir auch nicht die Mühe, in deinem Chaos durchzublicken.
    Aber ich habe dir eine Funktion geschrieben, mit der du beliebig viele Sheets in ein PDF exportieren kannst.

    Visual Basic-Quellcode

    1. Function ExportPdf(ByVal Path As String, ParamArray Sheets()) As Boolean
    2. Dim wb As Workbook, ws As Worksheet, i As Integer
    3. If UBound(Sheets) < LBound(Sheets) Then Exit Function
    4. On Error GoTo Done
    5. For i = LBound(Sheets) To UBound(Sheets)
    6. Set ws = Sheets(i)
    7. If wb Is Nothing Then
    8. ws.Copy
    9. Set wb = ActiveWorkbook
    10. Else
    11. ws.Copy After:=wb.Sheets(wb.Sheets.Count)
    12. End If
    13. Next
    14. wb.ExportAsFixedFormat Type:=xlTypePDF, Filename:=Path, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
    15. wb.Close False
    16. Done:
    17. ExportPdf = Err.Number = 0
    18. End Function

    Aufrufbeispiele:

    Visual Basic-Quellcode

    1. ExportPdf "c:\temp\test.pdf", Sheets("pant_monthly"), Sheets("daily_overview")
    2. If ExportPdf("c:\temp\test.pdf", Tabelle1, Tabelle2, Tabelle3) Then MsgBox "erfolgreich exportiert"
    --
    If Not Program.isWorking Then Code.Debug Else Code.DoNotTouch
    --

    Dieser Beitrag wurde bereits 2 mal editiert, zuletzt von „petaod“ ()

    Neu

    inrid schrieb:

    hab die Lösung nun selbst herausgefunden

    Das freut mich!
    Es wäre schön, wenn du deine Lösung kurz mit uns teilst. :)
    Lg, Acr0most
    Wenn das Leben wirklich nur aus Nullen und Einsen besteht, dann laufen sicherlich genügen Nullen frei herum. :D
    Signature-Move 8o
    kein Problem mit privaten Konversationen zu Thema XY :thumbup:

    Neu

    Sub ExportAsPDF()
    Dim rng As Range
    Dim arr As Variant
    Dim sFile As String, sPath As String

    sPath = Environ("USERPROFILE") & "\Desktop"
    sPath = sPath & "\PDF_" & Format(Date, "yyyyMMdd") & "_" & Format(Now, "hhmmss")

    MkDir sPath

    arr = Array(Worksheets(1).Name, Worksheets(2).Name)


    For Each rng In Range("PLANTS").Cells
    sFile = sPath & "\" & rng.Value & ".pdf"
    Range("C2").Value = rng.Value

    Worksheets(arr).Copy

    ActiveWorkbook.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
    sFile, Quality:=xlQualityStandard, _
    IncludeDocProperties:=True, _
    IgnorePrintAreas:=False, _
    OpenAfterPublish:=False

    ActiveWorkbook.Close savechanges:=False
    Next rng


    End Sub