Speichern von zwei Tabellenblättern in XLSX & PDF
24.01.2017 22:47:51
zwei
mein Code - unten eingefügt funktioniert. er soll nur erweitert werden.
Die Funktion:
Speichern der "Tabelle1" in einem vorgegeben Ordner- mit Auswahlmöglichkeit.
Die Tabelle1 wird in XLSX und PDF in ein und dem selben Ordner abgespeichert.
Folgendes soll jetzt eingearbeitet werden:
Der Mappe wurde ein Deckblatt hinzugefügt.
Dieses hat den Namen "Deckblatt" und soll auch mit diesen Namen in den gleichen Ordner wie die "Tabelle1" ebenfalls als XLSX und PDF gespeichert werden.
Option Explicit
Public Sub Speichern_in_PDF_XLSX()
Dim varPath As Variant
On Error GoTo Fin
varPath = Application.GetSaveAsFilename( _
InitialFileName:="D:\Prüfungsordner\", _
FileFilter:="Excel(*.xlsx), *.xlsx", _
Title:="Save as XLSX and PDF")
If Not varPath = False Then
If Dir(varPath) "" Then
Select Case MsgBox("Datei überschreiben?", 4 Or 32 Or 0, "Datei")
Case vbYes
With Application
.ScreenUpdating = False
.DisplayAlerts = False
End With
Sheets("Tabelle1").Copy
With ActiveWorkbook
.SaveAs varPath, 51
.ExportAsFixedFormat Type:=xlTypePDF, Quality:=xlQualityStandard, _
IncludeDocProperties:=True, IgnorePrintAreas:=True
.Close False
End With
End Select
Else
Sheets("Tabelle1").Copy
With ActiveWorkbook
.SaveAs varPath, 51
.ExportAsFixedFormat Type:=xlTypePDF, 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
Was müsste nun wo am Code geändert werden- habe schon probiert- kam noch nix brauchbares heraus.
Danke erst mal
LG Andi