SaveAs Dialog exakt wie in Excel

norman · 1970-01-01T00:00:00+00:00

Hallo alle, irgend wie stehe ich auf dem Schlauch. Ich will einen SaveAs-File Dialog, der genau wie der Excel-Save-As Dialog funktionert. Habe mit GetSaveAsFilename experimentiert, ist schon nicht schlecht, aaaaaber: Es fehlt beim "Extras Button" der Eintrag "Allgemeine Optionen" - den brauche ich aber, weil die User das auch angeben können sollen... Hat jemand eine Idee? Viele Grüße Norman

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

Hallo Norman,
du kann ja auch die statistischen Daten speichern nachdem der Speichern-Untervorgang abgeschlossen wurde. ggf. muss man die zu speichernden Infos vorher merken.
Allerdings kommt dann immer, wenn man die Datei unter dem gleichen Namen speichern will, eine Meldung dies zu bestätigen. Wenn der gleiche Dateiname nicht möglich sein soll, dann ggf. Datei immer schreibgeschützt öffnen lassen oder eine Mustervorlage verwenden.
Gruß
Franz

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Dim vSaveAs, sInfo1(1 To 2), sInfo2(1 To 2)
On Error GoTo Fehler
Cancel = True
Application.EnableEvents = False 'Verhindert rekursiven Aufruf von BeforePrint
'Speicher unter im Dialog anzeigen - Optionen möglich
'Daten der aktiven datei merken
sInfo1(1) = Me.Name
sInfo1(2) = Me.Path
Application.DisplayAlerts = False
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"
'Infos speichern wenn speichern abgebrochen wurde
Else
'Infos speichern, wenn Speichern-Untern durchgeführt wurde.
sInfo2(1) = ActiveWorkbook.Name
sInfo2(2) = ActiveWorkbook.Path
MsgBox "Datei wurde gespeichert!" & vbLf _
& "Name alt:  " & sInfo1(1) & vbLf _
& "Name neu:" & sInfo2(1) & vbLf _
& "Verzeichnis alt:  " & sInfo1(2) & vbLf _
& "Verzeichnis neu:" & sInfo2(2), vbInformation + vbOKOnly, _
"D A T E I    S P E I C H E R N" 'Testzeile
End If
Err.Clear
Fehler:
Application.DisplayAlerts = True
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

Forumthread: SaveAs Dialog exakt wie in Excel

10
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Forumthreads zu verwandten Themen

Infobox / Tutorial