Save as XLSX und PDF
02.09.2017 16:48:39
Knauer
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