AW: SaveAs Dialog exakt wie in Excel
15.01.2010 16:10:06
fcs
Hallo Norman,
das Speichern/Speichern unter in das BeforeSave-Ereignismakro einbauen ist aber etwas tricky.
Zum einen muss du den gestarteten Speicher-Vorgang ggf. canceln und du muss zeitweise die Ereignismakros deaktivieren, damit der im Makro eingebaute Speichervorgang das Ereignis nicht nochmals aufruft (rekursiver Aufruf).
Neben dem Speichern-unter-Dialog, den ich hier aber doch verwenden würde. Gibt es unter VBA auch noch einen GetSaveAs-Dialog, der die Auswahl/Eingabe eines dateinamens erlaubt ohne beim Schließen die Datei zu speichern. Allerdingst gibt es in diesem Dialog nicht die Möglichkeit die Optionen zu ändern/auszuwählen.
Nachfolgend Beispiele für beide Varianten.
Gruß
Franz
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Dim vSaveAs
On Error GoTo Fehler
Cancel = True
Application.EnableEvents = False 'Verhindert rekursiven Aufruf von BeforePrint
'Speichernamen im Dialog abfragen/eingebn - Optionen nicht möglich
'vSaveAs = Application.GetSaveAsFilename(fileFilter:="Excel(*.xls;*.xlsx;*.xlsm;*.xlsb)," _
& "*.xls;();*.xlsx;*.xlsx;*.xlsb", _
Title:="Bitte Namen der Datei für Speichern Unter wählen", _
Buttontext:="Speichern Unter")
vSaveAs = Application.GetSaveAsFilename(InitialFileName:=Me.Name, _
fileFilter:="Excel(*.xls;*.xlsx;*.xlsm;*.xlsb)," _
& "*.xls;();*.xlsx;*.xlsx;*.xlsb", _
Title:="Bitte Namen der Datei für Speichern Unter wählen", _
Buttontext:="Speichern Unter")
If vSaveAs False Then 'Dialog wurde nicht abgebrochen
Me.SaveAs vSaveAs
Else
End If
Err.Clear
Fehler:
With Err
Select Case .Number
Case Is = 0 'Alles OK
Case Else
MsgBox "Fehler-Nr.: " & .Number & vbLf & .Description
End Select
End With
Application.EnableEvents = True
End Sub
'oder
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Dim vSaveAs
On Error GoTo Fehler
Cancel = True
Application.EnableEvents = False 'Verhindert rekursiven Aufruf von BeforePrint
'Speicher unter im Dialog anzeigen - Optionen möglich
vSaveAs = Application.Dialogs(xlDialogSaveAs).Show(arg1:=Me.Name)
If vSaveAs = False Then MsgBox "Datei wurde nicht gespeichert!", vbInformation + vbOKOnly, _
"D A T E I S P E I C H E R N"
Err.Clear
Fehler:
With Err
Select Case .Number
Case Is = 0 'Alles OK
Case Else
MsgBox "Fehler-Nr.: " & .Number & vbLf & .Description
End Select
End With
Application.EnableEvents = True
End Sub