Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
640to644
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
640to644
640to644
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

Unerwünschter Loop bei "Workbook_BeforeSave"

Unerwünschter Loop bei "Workbook_BeforeSave"
22.07.2005 11:42:45
Martin
Hallo Zusammen
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

6
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Unerwünschter Loop bei "Workbook_BeforeSave"
22.07.2005 11:56:37
Frederik
Hallo!
Ansatz: enableevents = true / false (before_save wird danach nicht mehr angesprocghen)
Vielleicht kommst du damit weiter?
Gruß
F.
AW: Unerwünschter Loop bei "Workbook_BeforeSave"
22.07.2005 12:57:33
Martin
Hallo Frederik
habe ich auch versucht, aber das geht leider nicht weil der Dialog "close" bereits aktiv ist.
Eventuell könnte man beim Dialog "Workbook_BefoerClose"

Private Sub Workbook_BeforeClose(Cancel As Boolean)
Application.EnableEvents = False
Workbook_BeforeSave
Application.EnableEvents = True
End Sub

aber das läuft so leider nicht
Fehlermeldung Argument ist nicht optional
Danke für die Mithilfe
Martin
Anzeige
AW: Unerwünschter Loop bei "Workbook_BeforeSave"
22.07.2005 13:03:11
Frederik
Hallo!
Ich würde den ganzen Code, der unter before_close, before_save, .. steht in eine Function packen. Dann würde ich bei before_close, before_save, .. mit b=true / false arbeiten und dieses in der funktion entsprechend behandeln. also wenn z.b. before_close läuft b=false setzen, absprung in die function & dann mit enable.. arbeiten.
Gruß
F.
AW: Unerwünschter Loop bei "Workbook_BeforeSave"
22.07.2005 13:37:13
Martin
Hallo Frederik
Danke für Deinen Ansatz zur Lösung, leider ist dies der Grund weshalb ich bei VBA nur gut eingetragen habe, das mit den Funktionen und die Parameterübergabe da habe ich einigen Lernbedarf nötig.
Wer kann mir da ein bisschen unter die Arme greifen?
Bitte den Code anpassen damit ich und eventuell auch jemand anderes der auf diesem Forum sucht dabei etwas lernen kann, werde wenn die Lösung funktioniert bestimmt nur einmal die selbe Frage stellen.

Private Sub Workbook_BeforeClose(Cancel As Boolean)
if b = false
Application.EnableEvents = False
'Functionsaufruf
SecureSave
'und jetzt das mit dem Parameter
b = True
Application.EnableEvents = True
end if
End Sub


Private Sub Workbook_BeforeSave(Cancel As Boolean)
if b = false then
Application.EnableEvents = False
'Functionsaufruf
SecureSave
'und jetzt das mit dem Parameter
b = True
Application.EnableEvents = True
end if
End Sub

Function SecureSave (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 Function
Mit dankendem Gruss
Maritn
Anzeige
immer noch Loop bei "Workbook_BeforeSave"
22.07.2005 23:04:54
Martin
Hallo Zusammen
leider konnte ich bis jetzt das Problem nicht beheben, das mit der Function ist mir neu (kenne ich noch nicht) habe bis jetzt immer ohne Functionen gearbeitet.
Könnte mit eventuell jemand helfen das Problem zu beheben?
habe diesmal die Datei ins Netz gestellt.
https://www.herber.de/bbs/user/24940.xls
Unendlichen Dank
Martin
Es ist vollendet
25.07.2005 20:07:47
Martin
Hallo Zusammen
Danke für die Mithilfe, nachdem ich den Tread neu erstell und vermutlich besser beschrieben, hatte sich umgehend eine Lösung ergeben.
Danke allen Helfenden
Gruss
Martin
Anzeige

34 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige