beforeClose/beforeSave Endlosschlaufe verhindern
25.07.2005 11:41:18
Manhart
Erneut rufe ich um Hilfe für ein mir noch nicht lösbares Problem.
in einem alten Tread habe ich um Hilfe für das Problem gebeten, leider noch ohne Lösung. Da dieser Tread nun sehr weit im unteren Bereich ist versuche ich das Problem neu zu beschreiben, eventuell war die erste Variante sehr schlecht formuliert.
wenn die Datei geschlossen ider gespeichert wird, sollte vorerst eine Prüfung stattfinden, danach die Datei gespeichert oder gegebenenfalls geschlossen werden.
Hier mein Versuch (leider nicht lauffähig)
Im Modul "Diese Arbeitsmappe" habe ich den folgenden Script:
Private Sub Workbook_BeforeClose(Cancel As Boolean)
If Not schliessen_ok Then Cancel = True
'hier wollte ich die Procedur aufrufen, geht aber nicht
'SecureSave
'Cancel = True
End Sub
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
If Not schliessen_ok Then Cancel = True
'hier wollte ich wiederum die Procedur aufrufen, geht aber auch nicht
'SecureSave
'Cancel = True
End Sub
'in einem Normalen Modul den folgenden Code:
Option Explicit
Public schliessen_ok As Boolean
Public Sub SecureSave()
Dim Wsh, sh, qt 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.")
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
Application.EnableEvents = True
End
End If
'Sheets("Querry") QuerryTables Delete
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
Else
If FE = "ja" And (FilenameU14) 0 Then
Application.Dialogs(xlDialogSaveAs).Show (FilenameU14)
Else
Application.Dialogs(xlDialogSaveAs).Show (ThisWorkbook.Name)
End If
schliessen_ok = True
Application.EnableEvents = True
End If
Fehler:
schliessen_ok = False
Application.EnableEvents = True
End Sub
Den Code hatte ich eigentlich zur besseren Darstellung für Euch Formatiert mit einrücken und Tabulator, aber es will einfach nicht im Forum so erscheinen Sorry.
Besten Dank all denen die mir dabei helfen wollen.
Gruss
Martin