Achso...
04.08.2016 15:19:18
Michael
Hallo Andi!
Naja, da hab ich Dich nicht vollumfänglich verstanden... das ist dann doch aufwändiger:
Private Sub Workbook_BeforeClose(Cancel As Boolean)
'Prüft vor dem Schließen dieser Mappe ob Änderungen vorliegen/gespeichert wurde
'Liegen Änderungen vor bzw. wurde noch nicht gespeichert, kann gewählt werden ob
'diese Mappe gespeichert wird - ja speichert Mappe + Sicherheitskopie, nein speichert
'weder diese Mappe noch Sicherheitskopie
'Wurde Mappe vor dem Schließen nicht verändert bzw. bereits gespeichert, dann wird keine
'Sicherheitskopie erstellt und Mappe einfach geschlossen.
Dim WbZ As Workbook
Dim Pfad$, Dname$, Info
Pfad = "U:\Test\"
Dname = "Übersicht.xlsx"
Application.ScreenUpdating = False
Application.DisplayAlerts = False
With Me
If Not .ReadOnly Then
Select Case .Saved
'Mappe wurde geändert aber NICHT gespeichert
'Abfrage ob die Original-Mappe überhaupt gespeichert werden soll
Case Is = False
Info = MsgBox("Die Mappe wurde noch nicht gespeichert." & vbLf & _
"Soll diese Mappe gespeichert werden?", vbYesNo, _
"Schließen und Speichern?")
'Wenn Mappe vor dem Schließen gespeichert wird,
'dann Sicherheitskopie
If Info = vbYes Then
.Save
.Sheets.Copy
Set WbZ = ActiveWorkbook
With WbZ
.SaveAs Filename:=Pfad & Dname, _
FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
.Close True
End With
.Close
'Wenn Mappe vor dem SChließen NICHT gespeichert wird,
'dann KEINE Sicherheitskopie
Else:
.Saved = True
.Close
End If
'Mappe wurde NICHT geändert oder bereits gespeichert
'Dann KEINE Sicherheitskopie
End Select
End If
End With
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
'Speichert eine Sicherheitskopie der Mappe (ohne Makros) bei jedem Speichern
'der Originalmappe, außer bei "Speichern unter..."
Dim WbZ As Workbook
Dim Pfad$, Dname$
Pfad = "U:\Test\"
Dname = "Übersicht.xlsx"
Application.ScreenUpdating = False
Application.DisplayAlerts = False
With Me
If Not .ReadOnly And SaveAsUI = False Then
.Sheets.Copy
Set WbZ = ActiveWorkbook
With WbZ
.SaveAs Filename:=Pfad & Dname, _
FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
.Close True
End With
End If
End With
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub
Die kombinierten Codes machen jetzt Folgendes:
1) Bei jedem Speichern Deiner Original-Mappe, wird eine Sicherheitskopie angelegt (NICHT wenn Du das Original mit "Speichern unter" als neues Original abspeicherst) ohne Makros.
2) Vor dem Schließen der Original-Mappe wird geprüft ob Änderungen vorliegen, die noch nicht gespeichert wurden. Liegen keine Änderungen vor bzw. wurde davor irgendwann schon gespeichert, und danach nichts mehr geändert, wird die Original-Mappe einfach geschlossen und keine Sicherheitskopie erstellt. Liegen aber Änderungen in der Mappe vor muss in einem eigenen Dialog gewählt werden ob gespeichert werden soll oder nicht - bei ja wird die Original-Mappe UND eine Sicherheitskopie gespeichert, bei nein weder noch.
Ich hoffe das ist jetzt das, was Du Dir vorgestellt hast. Bzgl. ".Sheets.Copy" - das musst Du drinnen lassen... Das bedeutet nichts anderes, als dass alle Blätter der Mappe zusammen in eine neue Mappe kopiert werden und diese neue Mappe dann gespeichert wird. Das ist wichtig, um mit 2 Objekten arbeiten zu können, mit der Original-Mappe und ihrer Sicherheitskopie. Das hat zuvor nur ohne ".Sheets.Copy" funktioniert, weil wir einen Spezialfall erwischt haben - in der o.a. Konstruktion klappt das nicht mehr verlässlich.
LG
Michael