Zusätzlich beim speichern ein Tabellenblatt als PDF ablegen...

OptionExplicit
PrivateDeclareFunctionMakeSureDirectoryPathExists_
Lib"imagehlp.dll"(ByValPfadAsString)AsLong
PrivateDeclareFunctionPathFileExistsLib"shlwapi.dll"_
Alias"PathFileExistsA"(ByValpszPathAsString)AsLong
' Pfad für die PDF-Datei MIT abschliessendem Backslash anpassen!!!!
ConststrPDFPathAsString="C:\Temp\"
'--------------------------------------------------------------------------
' Module    : ThisWorkbook
' Procedure : Workbook_BeforeSave
' Author    : Case (Ralf Stolzenburg)
' Date      : 28.11.2013
' Purpose   : Always save as PDF in particular folder...
'--------------------------------------------------------------------------
PrivateSubWorkbook_BeforeSave(ByValSaveAsUIAsBoolean,CancelAsBoolean)
DimlngCalcAsLong
' Wenn ein Fehler auftritt gehe zu der angegebenen Sprungmarke
OnErrorGoToFin
' Die Excelapplikation wird ruhig gestellt - UNBEDINGT wieder einschalten
WithApplication
.ScreenUpdating=False
.EnableEvents=False
.DisplayAlerts=False
lngCalc=.Calculation
.Calculation=xlCalculationManual
.DisplayAlerts=False
EndWith
' Name des Tabellenblattes anpassen!!!!!
WithThisWorkbook.Worksheets("Sheet1")
' Prüfen ob Ordner vorhanden ist
IfPathFileExists(strPDFPath)<>0Then
' PDF-Datei im vorgegebenen Pfad erstellen - NUR ein Tabellenblatt
' Dateiname ist wie Exceldateiname mit Datum und Uhrzeit
'.ExportAsFixedFormat 0, strPDFPath & fncEXT(.Parent.Name) & _
Format(Now,"_YYYY_MM_DD_hh_mm_ss")
' Dateiname ist wie Exceldateiname VORHANDENE DATEI WIRD ERSETZT
.ExportAsFixedFormat0,strPDFPath&fncEXT(.Parent.Name)
' PDF-Datei im vorgegebenen Pfad erstellen - NUR ein Tabellenblatt
' Dateiname ist wie Worksheetname mit Datum und Uhrzeit
'.ExportAsFixedFormat 0, strPDFPath & .Name & _
Format(Now,"_YYYY_MM_DD_hh_mm_ss")
' Dateiname ist wie Worksheetname VORHANDENE DATEI WIRD ERSETZT
'.ExportAsFixedFormat 0, strPDFPath & .Name
Else
' Pfad anlegen
MakeSureDirectoryPathExists(strPDFPath)
' PDF-Datei im vorgegebenen Pfad erstellen
.ExportAsFixedFormat0,strPDFPath&fncEXT(.Parent.Name)&_
Format(Now,"_YYYY_MM_DD_hh_mm_ss")
EndIf
Application.Run("Module1.Main")
EndWith
Fin:
' Die Applikation aufwecken
WithApplication
.ScreenUpdating=True
.EnableEvents=True
.DisplayAlerts=True
.Calculation=lngCalc
.DisplayAlerts=True
.CutCopyMode=True
EndWith
' Wenn ein Fehler auftritt gib ihn aus mit Fehlernummer und Beschreibung
IfErr.Number<>0ThenMsgBox"Error: "&_
Err.Number&" "&Err.Description
EndSub
' Name und Extension trennen
FunctionfncEXT(ByValstrNameAsString)AsString
fncEXT=Mid(strName,1,InStr(strName,".")-1)
EndFunction

OptionExplicit
'--------------------------------------------------------------------------
' Module    : Module1
' Procedure : Main
' Author    : Case (Ralf Stolzenburg)
' Date      : 28.11.2013
' Purpose   : Ausblenden Druckvorschaulinien. Hide print preview lines...
'--------------------------------------------------------------------------
PrivateSubMain()
DimwksSheetAsWorksheet
ForEachwksSheetInThisWorkbook.Worksheets
' Die Druckvorschaulinien ausblenden
wksSheet.DisplayAutomaticPageBreaks=False
NextwksSheet
EndSub