Automatisch Kopie speichern von .xlsm
29.12.2019 10:41:28
.xlsm
Habe diesen VBA Code im Forum gefunden, ist echt super...nur es speichert in .xlsx format.
Ist es möglich das der selbe Code in .xlsm format speichern tut ?
.. und wenn möglich im gespeicherten namen noch automatisch das datum hinzufügt?
anbei der in diesem Forum gefunder VBA Code (...ist echt super der Code...fast perfekt...fehlt nur..:-)
Code ist soweit ich im Forum sehen konnte vom Michael (migre)...Danke ihn schon mal vorab :-)
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
Danke im Voras
Niko
