AW: Blattschutz wenn A1 gefüllt
16.06.2013 10:32:37
fcs
Hallo Heike,
damit sich der Hund nicht in den Schwanz beißt muss die Logik im WorkbookOpen-Makro etwas optimiert werden und die Ereignismakros müssen zeitweise deaktiviert werden.
Das WorkbookBeforeClose-Makro ist nicht erforderlich, da je nach Auswahl im Warndialog dann das BeforeSave-Makro ausgeführt wird.
Das Makro sperrt in den beiden Blättern jetzt zusätzlich alle nicht gesperrten Zellen.
Gruß
Franz
'Code unter Diese Arbeitsmappe
Private Sub Workbook_Open()
Application.DisplayAlerts = False
Dim iButton As Integer, Auswahl As Variant
Dim Dateiname As String
If Me.Worksheets("Einkauf").Cells(1, 1) = "" Then
Dateiname = Format(Date, "yyyy-mm-dd")
iButton = MsgBox("Bitte die Datei unter einem neuen Namen speichern!", _
vbInformation + vbOKCancel, _
"A C H T U N G!!!")
If iButton = vbOK Then
Application.EnableEvents = False 'verhindert, dass Ereignismakros gestartet werden
Auswahl = Application.Dialogs(xlDialogSaveAs).Show(Dateiname)
Application.DisplayAlerts = True
Application.EnableEvents = True 'Ereignismakros wieder aktivieren
If Auswahl = False Then
Me.Close savechanges:=False
End If
ElseIf iButton = vbCancel Then
ThisWorkbook.Close savechanges:=False
End If
End If
If ActiveWorkbook.Name = "Heike_org.xlsm" Then
Application.DisplayAlerts = True
Exit Sub
Else
Application.DisplayAlerts = True
With Worksheets("Einkauf").Cells(1, 1)
If .Value = "" Then
.Value = "x"
Application.EnableEvents = False
Me.Save
Application.EnableEvents = True
End If
End With
End If
End Sub
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Dim Zelle As Range
If LCase(Me.Worksheets("Einkauf").Range("A1")) = "x" Then
With Me.Worksheets("Einkauf")
.Unprotect Password:="Test"
For Each Zelle In .UsedRange.Cells
If Zelle.Locked = False Then Zelle.Locked = True
Next
.Protect Password:="Test"
End With
With Me.Worksheets("Verkauf")
.Unprotect Password:="Test"
For Each Zelle In .UsedRange.Cells
If Zelle.Locked = False Then Zelle.Locked = True
Next
.Protect Password:="Test"
End With
End If
End Sub