VBA Speicherung XLS*+PDF+PDF in anderen Ordner
05.12.2016 20:47:59
Heike
meinen Code hier konnte ich soweit anpassen, das er
*Die Tabelle1 aus der Mappe in einem Speicherort meiner Wahl als XLSX sowie gleichzeitig mit gleichen Namen, im selben Ordner als PDF abspeichert.
Und nicht nur ein Blatt- sondern alle Blätter in der Tabelle1 durch "Parameter IgnorePrintAreas:=True"
Nun soll jedoch diese erstellte PDF, die später gebrannt werden soll- zusätzlich in einem anderen Ordner ( F:\Mein Brennordner\) abgespeichert werden. Kann der Code dahingehend angepasst werden?
Vielleicht so, das sich am Ende dieser Prozedur eine MSG Box öffnet, die schreibt
" Die Tabelle1 wurde erfolgreich im Ordner *.... evtl. den Speicherort* gespeichert." (reicht aber erfolgreich gespeichert- ohne Ortangabe)
" Soll eine weitere Kopie der PDF in einem anderen Ordner gespeichert werden? "
Wenn ja : Aufforderung für Speicherort - " über Windows-Explorer "
(wobei, wenn das zu Aufwendig werden sollte - es auch mit einem festen Brennordner getan wäre) * InitialFileName:="F:\Mein Brennordner\", *
Wenn Nein : Abbrechen und schließen
*sollte bei der weiteren Speicherung der PDF der "Dateiname" in dessen Ordner bereits existieren- dann vielleicht ein Warnhinweis für "Überschreibung" oder "Abbrechen" ausgegeben werden.
Kann mir da jemand helfen?- Ist für meine VBA Kenntnisse zu Kompliziert- der Makrorecorder hilft mir hier nicht wirklich.
Option Explicit
Public Sub Speichern_in_PDF_XLSX()
Dim varPath As Variant
On Error GoTo Fin
varPath = Application.GetSaveAsFilename( _
InitialFileName:="G:\Überarbeitung \", _
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
Danke Euch.
Grüße Heike
Anzeige