Blattschutz wenn A1 gefüllt

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

'Makro im VBA-Editor unter "DieseArbeitsmappe" der Datei Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean) If LCase(Me.Worksheets("Einkauf").Range("A1")) = "x" Then Me.Worksheets("Einkauf").Protect Password:="Test" Me.Worksheets("Verkauf").Protect Password:="Test" End If End Sub

Private Sub Workbook_Open() Application.DisplayAlerts = False Dim iButton As Integer 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.Dialogs(xlDialogSaveAs).Show Dateiname ElseIf iButton = vbCancel Then ThisWorkbook.Close SaveChanges:=False End If End If If ActiveWorkbook.Name = "Heike_org.xlsm" Then Exit Sub Else Worksheets("Einkauf").Cells(1, 1) = "x" End If Application.DisplayAlerts = True End Sub Private Sub Workbook_BeforeClose(Cancel As Boolean) If LCase(Me.Worksheets("Einkauf").Range("A1")) = "x" Then Me.Worksheets("Einkauf").Protect Password:="Test" Me.Worksheets("Verkauf").Protect Password:="Test" End If End Sub

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

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" .Cells.Locked = True .Protect Password:="Test" End With With Me.Worksheets("Verkauf") .Unprotect Password:="Test" .Cells.Locked = True .Protect Password:="Test" End With End If End Sub

Beliebteste Forumthreads (12 Monate)

10 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

10
Beiträge zum Forumthread

Beiträge zu diesem Forumthread