Anzeige
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Endlosschleife bei Makro beim Speichern

Endlosschleife bei Makro beim Speichern
stormlamp
Hallo Zusammen,
auf einem gesperrten Tabellenblatt ist eine Makro-Schaltfläche, in der beim Öfnnen der Datei als Text steht "Makros sind gesperrt". Wenn der öffnende Rechner Makros zulässt, wird der Text ersetzt durch "Aktualisieren", also das, was das Makro tut.
Wenn die Datei gespeichert wird, ist nicht sichergestellt, dass der nächste öffnende Rechner Makros zulässt. Also muss ich beim Speichern wieder reinschreiben "Makros sind gesperrt".
Da der Benutzer jedoch nach dem Speichern weiterarbeiten kann, muss ich sofort nach dem Speicherprozess den Text in der aktuellen Mappe wieder auf "Aktualisieren" zurückstellen.
Das funktioniert bis dahin auch alles. Nur wenn das Dokument geschlossen wird mit speichern, kommt die Mappe in eine Endlosschleife. Da ja (während des Schließens) nach dem Speichern die Datei wieder geändert wird, erkennt Excel die Änderung und fragt, ob es die speichern soll, wenn ja, wird wieder hin- und zurück geändert, sodass ich in einer Endlosschleife lande. Wie komme ich aus der Schleife raus?
Im Anhang der gesamte Makrotext - bitte keine grauen Haare kriegen, ich kann kein VBA und habe mir die einzelnen Stücke aus dem Internet zusammengeschustert, solange bis alles funktionierte und keine Fehlermeldungen erschienen..
--------------
Private Sub Workbook_Open()
' Makro Sicherheitspruefung
On Error Resume Next
Application.DisplayAlerts = False
ActiveSheet.Unprotect "passwort"
ActiveSheet.Shapes.Range(Array("Button 1")).Select
Selection.Characters.Text = "AKTUALISIEREN"
With Selection.Characters(Start:=1, Length:=13).Font
.Name = "Arial"
.FontStyle = "Fett"
.Size = 14
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = 50
End With
Range("A9").Select
ActiveSheet.Protect "password", DrawingObjects:=True, Contents:=True, Scenarios:= _
False
Range("B1").Select
Application.DisplayAlerts = True
On Error GoTo 0
End Sub

--------------
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Dim Dateiname As String
If SaveAsUI Then
Dateiname = Application.GetSaveAsFilename
End If
If Dateiname  "Falsch" Then
Sheets("intern 2").Select
ActiveSheet.Unprotect "password"
ActiveSheet.Shapes.Range(Array("Button 1")).Select
Selection.Characters.Text = "Makros sind gesperrt"
With Selection.Characters(Start:=1, Length:=20).Font
.Name = "Arial"
.FontStyle = "Fett"
.Size = 14
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = 3
End With
On Error Resume Next
Application.DisplayAlerts = False
Range("A9").Select
ActiveSheet.Protect "password", DrawingObjects:=True, Contents:=True, Scenarios:= _
False
Application.DisplayAlerts = True
On Error GoTo 0
End If
Cancel = True
Application.EnableEvents = False
Select Case Dateiname
Case ""
ThisWorkbook.Save
Case "Falsch"
Case Else
ThisWorkbook.SaveAs Dateiname
End Select
Application.EnableEvents = True
On Error Resume Next
Application.DisplayAlerts = False
ActiveSheet.Unprotect "password"
ActiveSheet.Shapes.Range(Array("Button 1")).Select
Selection.Characters.Text = "AKTUALISIEREN"
With Selection.Characters(Start:=1, Length:=13).Font
.Name = "Arial"
.FontStyle = "Fett"
.Size = 14
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = 50
End With
Range("A9").Select
ActiveSheet.Protect "password", DrawingObjects:=True, Contents:=True, Scenarios:= _
False
Application.DisplayAlerts = True
On Error GoTo 0
End Sub
-------------
Gruß
Hans

2
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Benutzer
Anzeige
AW: Endlosschleife bei Makro beim Speichern
26.06.2012 16:53:33
fcs
Hallo Hans,
ich dnke du kommst hier besser klar wenn du mit "Workbook_BeforeClose" arbeitest statt mit "Workbook_BeforeSave".
Gruß
Franz
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Dim bolSaved As Boolean
bolSaved = Me.Saved
On Error Resume Next
Application.DisplayAlerts = False
Sheets("intern 2").Select
ActiveSheet.Unprotect "password"
ActiveSheet.Shapes.Range(Array("Button 1")).Select
Selection.Characters.Text = "Makros sind gesperrt"
With Selection.Characters(Start:=1, Length:=20).Font
.Name = "Arial"
.FontStyle = "Fett"
.Size = 14
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = 3
End With
Range("A9").Select
ActiveSheet.Protect "password", DrawingObjects:=True, Contents:=True, Scenarios:= _
False
Application.DisplayAlerts = True
If bolSaved = True Then Me.Save
End Sub

Anzeige
AW: Endlosschleife bei Makro beim Speichern
26.06.2012 17:21:03
stormlamp
Hallo Franz,
Danke sehr, das klappt prima, und ist deutlich Kürzer :-)
Gruß
Hans

299 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige