Save as XLSX und PDF

Als Resultat meiner letzten Anfrage und der erhaltenen Lösung laufen meine Objekte aus einem Array zusammen mit einem zweiten Macro, indem letztlich einzelne, gefilterte Excelsheets erzeugt werden.
Das Ergebnis soll nun gesichert werden als *.xlsx und auch als PDF, das zur Anzeige benutzt wird. Meine Lösung ist sehr mechanisch (kann es leider noch nicht besser) für beide Fälle. Außerdem ist das Problem, dass bei einem zweiten Durchlauf (nach einer Änderung im Hauptfile) die Einzelfiles schon existieren und daher erst gelöscht werden müssen. Meine Lösung ist ein Macro mit einer delete-Funktion. Damit könnte ich leben.
Die Frage ist aber, wie könnte eine elegantere Lösung aussehen, die die ganze Prozedur automatisch ohne Rückfrage ablaufen läßt auch beim ersten und zweiten Mal. Meine Lösung sieht momentan so aus:

Option Explicit

Public Sub DeleteSheets()
'Raumpatchlisten selektieren
Sheets(Array("301", "302", "303", "304")).Select
Sheets("301").Activate
'Aktive Tabellen löschen
ActiveWindow.SelectedSheets.Delete
Sheets("3.OG").Select
'Folgemacro aufrufen
'Call RaumArray     - momentan nicht aktiviert
End Sub

Public Sub RaumArray()
Dim r As Variant
'Array mit den Raumnummern für die Raumpatchlisten
For Each r In Array("301", "302", "303", "304")
Call Tabelle(r)
Next
End Sub

Private Sub Tabelle(ByVal r As Variant)
'neue Tabelle aus Tab 300 erzeugen und ans Ende stellen
Worksheets("300").Copy After:=Sheets(Sheets.Count)
'Tabelle umbenennen
ActiveSheet.Name = r
'Tabelleninhalt löschen
Range("A2:T55").ClearContents
With Worksheets("3.OG")
'Haupttabelle 3.OG Raumspalte filtern
.Range("$A$1:$T$346").AutoFilter Field:=1, Criteria1:="=" & r
'Ergebnis kopieren zur neu erzeugten Tabelle
.UsedRange.Copy Range("A1")
'Filter deaktivieren
Call .ShowAllData
End With
Worksheets("3.OG").Select
End Sub

Public Sub SAVEasXLSX()
' SAVEasXLSX Makro
Sheets("301").Select
Sheets("301").Copy
ChDir "F:\Patchlisten"
ActiveWorkbook.SaveAs Filename:= _
"F:\Patchlisten\301_it_nw_pl_lanpatchliste.xlsx", FileFormat _
:=xlOpenXMLWorkbook, CreateBackup:=False
ActiveWindow.Close
Sheets("3.OG").Select
Sheets("302").Select
Sheets("302").Copy
ChDir "F:\Patchlisten"
ActiveWorkbook.SaveAs Filename:= _
"F:\Patchlisten\302_it_nw_pl_lanpatchliste.xlsx", FileFormat _
:=xlOpenXMLWorkbook, CreateBackup:=False
ActiveWindow.Close
Sheets("3.OG").Select
Sheets("303").Select
Sheets("303").Copy
ChDir "F:\Patchlisten"
ActiveWorkbook.SaveAs Filename:= _
"F:\Patchlisten\303_it_nw_pl_lanpatchliste.xlsx", FileFormat _
:=xlOpenXMLWorkbook, CreateBackup:=False
ActiveWindow.Close
Sheets("3.OG").Select
Sheets("304").Select
Sheets("304").Copy
ChDir "F:\Patchlisten"
ActiveWorkbook.SaveAs Filename:= _
"F:\Patchlisten\304_it_nw_pl_lanpatchliste.xlsx", FileFormat _
:=xlOpenXMLWorkbook, CreateBackup:=False
ActiveWindow.Close
Sheets("3.OG").Select
Call createPDF
End Sub

Public Sub createPDF()
' createPDF Makro
Sheets("301").Select
ChDir "F:\Patchlisten"
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
"F:\Patchlisten\301_it_nw_pl_lanpatchliste.pdf", Quality:= _
xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, _
OpenAfterPublish:=False
Sheets("302").Select
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
"F:\Patchlisten\302_it_nw_pl_lanpatchliste.pdf", Quality:= _
xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, _
OpenAfterPublish:=False
Sheets("303").Select
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
"F:\Patchlisten\303_it_nw_pl_lanpatchliste.pdf", Quality:= _
xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, _
OpenAfterPublish:=False
Sheets("304").Select
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
"F:\Patchlisten\304_it_nw_pl_lanpatchliste.pdf", Quality:= _
xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, _
OpenAfterPublish:=False
Worksheets("3.OG").Select
End Sub

Hallo Knauer,
teste mal:

Public Sub SAVEasXLSX()
    '
    ' SAVEasXLSX Makro
    '
    With Application
        .Calculation = xlCalculationManual
        .DisplayAlerts = False
        .EnableEvents = False
        .ScreenUpdating = False
    End With

    Worksheets("301").Copy
    With ActiveWorkbook
        .SaveAs Filename:= _
            "F:\Patchlisten\301_it_nw_pl_lanpatchliste.xlsx", _
            FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
        .Close
    End With

    Worksheets("302").Copy
    With ActiveWorkbook
        .SaveAs Filename:= _
            "F:\Patchlisten\302_it_nw_pl_lanpatchliste.xlsx", _
            FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
        .Close
    End With

    Worksheets("303").Copy
    With ActiveWorkbook
        .SaveAs Filename:= _
            "F:\Patchlisten\303_it_nw_pl_lanpatchliste.xlsx", _
            FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
        .Close
    End With

    Worksheets("304").Copy
    With ActiveWorkbook
        .SaveAs Filename:= _
            "F:\Patchlisten\304_it_nw_pl_lanpatchliste.xlsx", _
            FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
        .Close
    End With

    With Application
        .Calculation = xlCalculationAutomatic
        .DisplayAlerts = True
        .EnableEvents = True
        .ScreenUpdating = True
    End With

    Call createPDF

End Sub

Public Sub createPDF()
    '
    ' createPDF Makro
    '
    Worksheets("301").ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
        "F:\Patchlisten\301_it_nw_pl_lanpatchliste.pdf", Quality:= _
        xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, _
        OpenAfterPublish:=False

    Worksheets("302").ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
        "F:\Patchlisten\302_it_nw_pl_lanpatchliste.pdf", Quality:= _
        xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, _
        OpenAfterPublish:=False

    Worksheets("303").ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
        "F:\Patchlisten\303_it_nw_pl_lanpatchliste.pdf", Quality:= _
        xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, _
        OpenAfterPublish:=False

    Worksheets("304").ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
        "F:\Patchlisten\304_it_nw_pl_lanpatchliste.pdf", Quality:= _
        xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, _
        OpenAfterPublish:=False

End Sub

Gruß
Nepumuk

Forumthread: Save as XLSX und PDF

8
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Forumthreads zu verwandten Themen

Infobox / Tutorial

Speichern als XLSX und PDF in Excel VBA

Schritt-für-Schritt-Anleitung

Häufige Fehler und Lösungen

Alternative Methoden

Praktische Beispiele

Tipps für Profis

FAQ: Häufige Fragen

Beliebteste Forumthreads (12 Monate)