Private Sub Workbook_BeforeClose() und Private Sub Workbook_Open() funktionieren wie beabsichtigt.
Zum Sichern meines WB wollte ich dann das WB auf einer andere Festplatte meines Pc's speichern. Dazu diente Sub SaveWorkbookBackup(). Starte ich nun Sub SaveWorkbookBackup() durch Klicken auf eine entsprechende Schaltfläche wurde nun
Sub SaveWorkbookBackup() aufgerufen und funktionierte wie geplant.
Eine neues File wurde in D:\Datensicherung\Heute\ angelegt bzw. falls am gleichen Tag schon eine Sicherung erfolgt war, diese Sicherung überschrieben. Auch als ich SaveWorkbookBackup() in Private Sub Workbook_Open() legte funktioniert alles
wie erwarte.
Problem: lege ich SaveWorkbookBackup()in Private Sub Workbook_BeforeClose
erfolgt der Aufruf von Application.Dialogs(xlDialogSaveAs).Show. Offensichtlich ist jetzt
awb.Path = "" bwz Set awb = ActiveWorkbook hatte nicht funktioniert
Was kann ich ändern, damit die Sicherung nicht nur bein Öffnen des WB, sondern auch beim Schliessen erfolgen kann.
Rainer
Sub SaveWorkbookBackup()
Dim awb As Workbook, BackupFileName As String, i As Integer, da As Date, OK As Boolean
If TypeName(ActiveWorkbook) = "Nothing" Then Exit Sub
Set awb = ActiveWorkbook
If awb.Path = "" Then
Application.Dialogs(xlDialogSaveAs).Show
Else
BackupFileName = "D:\Datensicherung\Heute\" & awb.Name
i = 0
While InStr(i + 1, BackupFileName, ".") > 0
i = InStr(i + 1, BackupFileName, ".")
Wend
If i > 0 Then BackupFileName = Left(BackupFileName, i - 1)
da = Date
BackupFileName = BackupFileName & "_" & da & ".xls"
OK = False
On Error GoTo NotAbleToSave
With awb
Application.StatusBar = "Saving this workbook..."
.Save
Application.StatusBar = "Saving this workbook backup..."
.SaveCopyAs BackupFileName
OK = True
End With
End If
NotAbleToSave:
Set awb = Nothing
Application.StatusBar = False
If Not OK Then
MsgBox "Backup Copy Not Saved!", vbExclamation, ThisWorkbook.Name
End If
End Sub
Option Explicit
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Application.ScreenUpdating = False
SaveWorkbookBackup
Call EigeneMenüLeisteLöschen
Element_Hilfe_entfernt
With ActiveWindow
.DisplayHorizontalScrollBar = True
.DisplayVerticalScrollBar = True
.DisplayWorkbookTabs = True
.DisplayHeadings = True
End With
With Application
.CommandBars("Worksheet Menu Bar").Enabled = True
.CommandBars("Formatting").Enabled = True
.CommandBars("Standard").Visible = True
.DisplayFormulaBar = True
.DisplayStatusBar = True
End With
Application.ScreenUpdating = True
End Sub
Private Sub Workbook_Open()
Mldg = " Dein Name: A l e x a n d e r ' " ' Meldung definieren.
Stil = vbYesNo + vbDefaultButton2
Ergebnis = MsgBox(Mldg, Stil)
If Ergebnis = vbYes Then
TestzeichenF = "Ja"
alex = 1
Else
alex = 0
TestzeichenF = "Nein"
End If
H = 100 ' bei 100 sind die Beschränkungen vorhanden
If H = 100 Then
Application.WindowState = xlMinimized
With Application
.ScreenUpdating = False
.EnableEvents = True
.Caption = ActiveWorkbook.FullName
.MoveAfterReturn = True
.MoveAfterReturnDirection = xlToRight
.CommandBars("Worksheet Menu Bar").Enabled = False
.CommandBars("Formatting").Enabled = False
.CommandBars("Standard").Visible = False
.DisplayFormulaBar = False
.DisplayStatusBar = False
End With
With ActiveWindow
.DisplayHorizontalScrollBar = False
.DisplayVerticalScrollBar = False
.DisplayWorkbookTabs = False
.DisplayHeadings = False
End With
SaveWorkbookBackup
Call MenüErstellen
Call Anfang_E
Application.WindowState = xlMaximized
Application.ScreenUpdating = True
End If ' H=100
End Sub