Endlosschleife bei Makro beim Speichern
stormlamp
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