Mappe Speichern mit drei Sheets in XLSX
22.03.2017 20:12:21
Andi
Hallo; Excel VBA Helfer, hallo @ fcs- bräuchte doch noch etwas Hilfe.
Es geht mal wieder um das Speichern- ja es ist das "Public Sub Speichern_in_PDF_XLSX"
Dieses konnte ich dank @fcs sehr guten Anweisungen noch richtig ausbauen.
Es funktioniert alles sehr gut. Eine Abänderung wäre noch Sinnvoll.
Beim Speichern jetzt werden alle Sheets einzeln gespeichert. das war bisher in Ordnung.
Tabelle1 in PDF und XLSX
Deckblatt in PDF und XLSX und
Bearbeiten in XLSX.
Wo müsste ich was verändern, um die Tabelle1, Bearbeiten und das Deckblatt in einer Mappe zu Speichern, als XLSX.
(Reihenfolge wie oben)
Der PDF Rest - Tabelle1 und Deckblatt so belassen- also einzeln.
Public Sub Speichern_in_PDF_XLSX()
Dim varPath As Variant
Dim strDir As String
Dim wkb As Workbook
On Error GoTo Fin
varPath = Application.GetSaveAsFilename( _
InitialFileName:="D:\Elektro Arbeit\", _
FileFilter:="Excel(*.xlsx), *.xlsx", _
Title:="Save as XLSX and PDF")
If Not varPath = False Then
strDir = Left(varPath, InStrRev(varPath, "\"))
Set wkb = ActiveWorkbook
With Application
.ScreenUpdating = False
.DisplayAlerts = False
End With
If Dir(varPath) "" Then
Select Case MsgBox("Datei überschreiben?", 4 Or 32 Or 0, "Datei")
Case vbYes
wkb.Sheets("Tabelle1").Copy
With ActiveWorkbook
.SaveAs varPath, 51
.ExportAsFixedFormat Type:=xlTypePDF, Quality:=xlQualityStandard, _
IncludeDocProperties:=True, IgnorePrintAreas:=True
.Close False
End With
wkb.Sheets("Deckblatt").Copy
With ActiveWorkbook
.SaveAs strDir & "Deckblatt " & Format(Date, "YYYY-MM") & ".xlsx", _
51
.ExportAsFixedFormat Type:=xlTypePDF, _
Filename:=strDir & "Deckblatt " & Format(Date, "YYYY-MM") & ". _
pdf", _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, IgnorePrintAreas:=True
.Close False
End With
wkb.Sheets("Bearbeiten").Copy
With ActiveWorkbook
.SaveAs strDir & "Blatt Bearbeiten " & Format(Date, "YYYY-MM") & ".xlsx", _
51
End With
End Select
Else
wkb.Sheets("Tabelle1").Copy
With ActiveWorkbook
.SaveAs varPath, 51
.ExportAsFixedFormat Type:=xlTypePDF, Quality:=xlQualityStandard, _
IncludeDocProperties:=True, IgnorePrintAreas:=True
.Close False
End With
wkb.Sheets("Deckblatt").Copy
With ActiveWorkbook
.SaveAs strDir & "Deckblatt " & Format(Date, "YYYY-MM") & ".xlsx", 51
.ExportAsFixedFormat Type:=xlTypePDF, _
Filename:=strDir & "Deckblatt " & Format(Date, "YYYY-MM") & ".pdf", _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, IgnorePrintAreas:=True
.Close False
End With
wkb.Sheets("Bearbeiten").Copy
With ActiveWorkbook
.SaveAs strDir & "Blatt Bearbeiten " & Format(Date, "YYYY-MM") & ".xlsx", _
51
' .ExportAsFixedFormat Type:=xlTypePDF, _
' Filename:=strDir & "Bearbeiten.pdf", _
' Quality:=xlQualityStandard, _
' IncludeDocProperties:=True, IgnorePrintAreas:=True
.Close False
End With
End If
Else
MsgBox "Abgebrochen..."
End If
Fin:
With Application
.ScreenUpdating = True
.DisplayAlerts = True
End With
If Err.Number 0 Then MsgBox "Fehler: " & _
Err.Number & " " & Err.Description
End Sub