Unerwünschter Loop bei "Workbook_BeforeSave"
22.07.2005 11:42:45
Martin
Habe einen kleinen Fehler in meiner Logik, wenn das Dokument gespeichert wird, fange ich den Prozess ab mit "Workbook_BeforeSave" damit einige Sicherheitsabfragen gemacht werden können.
Nun ist es so, wenn das Dokument geschlossen wird nachdem die Speicherung erfolgt ist wird der Prozess richtig beendet.
Ist jedoch eine Änderung erfolgt und die Speicherung wurde unterlassen, kommt die Aufforderung vom Excel ob die Datei gespeichert werden soll, dabei entseteht der Loop weil ich den Prozess abfange.
Gibt es eine Möglichkeit diesen Loop zu verhindern?
Anbei der original Script.
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Dim sh As Object, BName As String
Dim Kennwort, KWort, FE
Dim x%
Dim Counter
Dim FilenameU14
Kennwort = "jajaja"
FilenameU14 = Sheets("Meldeblatt").Range("U14")
On Error GoTo Fehler
Application.EnableEvents = False
Counter = 0
'auf Querry Tabellen prüfen
For Each WSh In ThisWorkbook.Worksheets
For Each qt In WSh.QueryTables
Counter = Counter + 1
Next qt
Next WSh
'auf Namensänderung prüfen
For x = 1 To 10
If ThisWorkbook.Name = "Vorlage Meldeblatt Event-Aktionen" & x & ".xls" Or _
ThisWorkbook.Name = "Vorlage Meldeblatt Event-Aktionen" & x Then
FE = "ja"
x = 10
End If
Next x
'auf zu viele Tabellenblätter prüfen
If ThisWorkbook.Sheets.Count > 2 Then
For Each sh In ThisWorkbook.Sheets
If sh.Name <> "Meldeblatt" And sh.Name <> "Querry" Then BName = "Treffer"
Next sh
If BName = "Treffer" Then
For Each sh In ThisWorkbook.Sheets
If sh.Name <> "Meldeblatt" And sh.Name <> "Querry" Then
Application.DisplayAlerts = False
sh.Delete
Application.DisplayAlerts = True
End If
Next sh
Else
MsgBox ("Die Datei enthält mehrere Blätter. " & _
"Es kann jedoch nur ein Blatt gespeichert werden. " & _
"Um die Datei speichern zu können, müssen Sie dem zu speichernden Blatt " & _
"den Namen " & Chr$(34) & "Meldeblatt" & Chr$(34) & " geben. Alle anderen Blätter " & _
"werden gelöscht. Kopieren Sie diese Blätter daher vor dem Speichern jeweils in " & _
"eine eigene Datei.")
Cancel = True
End If
End If
If Counter > 0 Then
KWort = InputBox("VB-SCRIPT PROGRAMMING:" & Chr(10) & "DM-Planning-Team" & Chr(10) & Chr(10) & _
" Durch diese Aktion wird die Datenbankanbindung aus dem File entfernt, " & Chr(10) & _
" Aktivieren Sie diesen Schritt nur wenn die Erfassung , " & Chr(10) & _
" abgeschlossen ist und keine Änderungen mehr vorgenommen werden. " _
& Chr(10) & Chr(10) & "Geben Sie anschliessend bitte das Kennwort ein!")
If KWort <> Kennwort Then
MsgBox "Sie haben sich entschieden, das die Datei noch weiterbearbeitet wird." & Chr(10) & "Die Datei wird nun gespeichert!"
If FE = "ja" And (FilenameU14) <> 0 Then
Application.Dialogs(xlDialogSaveAs).Show (FilenameU14)
Else
Application.Dialogs(xlDialogSaveAs).Show (ThisWorkbook.Name)
End If
Cancel = True
Application.EnableEvents = True
End
End If
'Sheets("Querry").Select
Application.DisplayAlerts = False
With Sheets("Querry").Range("A1:M3")
.QueryTable.Delete
End With
With Sheets("Querry").Range("N1:O40")
.QueryTable.Delete
End With
With Sheets("Querry").Range("P1:T40")
.QueryTable.Delete
End With
Sheets("Meldeblatt").Select
Range("A1").Select
Application.DisplayAlerts = True
If FE = "ja" And (FilenameU14) <> 0 Then
Application.Dialogs(xlDialogSaveAs).Show (FilenameU14)
Else
Application.Dialogs(xlDialogSaveAs).Show (ThisWorkbook.Name)
End If
Cancel = True
Application.EnableEvents = True
Else
If FE = "ja" And (FilenameU14) <> 0 Then
Application.Dialogs(xlDialogSaveAs).Show (FilenameU14)
Else
Application.Dialogs(xlDialogSaveAs).Show (ThisWorkbook.Name)
End If
End If
Cancel = True
Fehler:
Application.EnableEvents = True
End Sub
da jetzt der Speicherprozess der durch das Datei Schliessen aufgerufen wurde
ausgeführt wird, läufet der Prozess wieder in den "Workbook_BeforeSave" usw. usw.
Ist möglicherweise ein Befehl da der den aktuell vom System aufgerufenen Speicherprozess abbricht?
Mit freundlichen Grüssen
Martin