Sperren trotz Freigabe geschützter Zellen

Private Sub Worksheet_Change(ByVal Target As Range) If Target.Column = 21 And Target.Count = 1 Then Me.Unprotect "xxx" Rows(Target.Row).Cells.Locked = Not IsEmpty(Target) Target.Locked = False Me.Protect "xxx" End If End Sub

Beitrag zum Forumthread

Beitrag zu diesem Forumthread

Betreff

Datum

Anwender

Hallo Tania,
hier ein etwas anderer Ansatz.
Nach Selektion einer Zelle wird geprüft, ob in der selektierten Zelle noch Änderungen zulässig sind. Dieser Status wird in einer Variablen gespeichert.
Wird die Zelle geändert, dann wird die Änderung rückgäng gemacht, wenn keine Änderung mehr zulässig ist.
Dies kann man allerdings umgehen, wenn die Makros beim Öffnen der datei nicht aktiviert werden.
Gruß
Franz

'Code in einem Tabellenblatt-Modul
Option Explicit
Private bolBlock1to5 As Boolean
Private bolBlock6 As Boolean, bolBlock7 As Boolean
Private bolBlock8to20 As Boolean
Private bolBlock21 As Boolean
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Zeile As Long
Application.EnableEvents = False
If Target.Cells.Count = 1 Then
Zeile = Target.Row
Select Case Target.Column
Case 1 To 5
If Not IsEmpty(Cells(Zeile, 6)) Or bolBlock1to5 = True Then
Application.Undo
MsgBox "In dieser Zeile sind in Spalte A bis E keine Änderungen mehr zulässig!"
Target.Offset(0, 1).Select
End If
Case 6
If Not IsEmpty(Cells(Zeile, 7)) Or bolBlock6 = True Then
Application.Undo
MsgBox "In dieser Zeile sind in Spalte A bis F keine Änderungen mehr zulässig!"
Target.Offset(0, 1).Select
End If
Case 7
If Not IsEmpty(Cells(Zeile, 21)) Or bolBlock7 = True Then
Application.Undo
MsgBox "In dieser Zeile sind in Spalte A bis G keine Änderungen mehr zulässig!"
Target.Offset(0, 1).Select
End If
Case 8 To 20
If Not IsEmpty(Cells(Zeile, 21)) Or bolBlock8to20 = True Then
Application.Undo
MsgBox "In dieser Zeile sind in Spalte A bis T keine Änderungen mehr zulässig!"
Target.Offset(0, 1).Select
End If
Case 21
If bolBlock21 = True Then
Application.Undo
MsgBox "In dieser Zeile sind in Spalte A bis U keine Änderungen mehr zulässig!"
Target.Offset(0, 1).Select
End If
Case Is > 21
'do nothing
End Select
Else
Application.Undo
MsgBox "Es darf immer nur eine Zelle geändert werden!"
End If
Application.EnableEvents = True
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim Zeile As Long
bolBlock1to5 = False
bolBlock6 = False
bolBlock7 = False
bolBlock8to20 = False
bolBlock21 = False
If Target.Cells.Count = 1 Then
Zeile = Target.Row
Select Case Target.Column
Case 1 To 5
bolBlock1to5 = Not IsEmpty(Cells(Zeile, 6))
Case 6
If Not IsEmpty(Cells(Zeile, 7)) Or Not IsEmpty(Target) Then
bolBlock1to5 = True
bolBlock6 = True
End If
Case 7
If Not IsEmpty(Cells(Zeile, 21)) Or Not IsEmpty(Target) Then
bolBlock1to5 = True
bolBlock6 = True
bolBlock7 = True
End If
Case 8 To 20
If Not IsEmpty(Cells(Zeile, 21)) Then
bolBlock1to5 = True
bolBlock6 = True
bolBlock7 = True
bolBlock8to20 = True
End If
Case 21
If Not IsEmpty(Target) Then
bolBlock1to5 = True
bolBlock6 = True
bolBlock7 = True
bolBlock8to20 = True
bolBlock21 = True
End If
Case Is > 21
bolBlock1to5 = True
bolBlock6 = True
bolBlock7 = True
bolBlock8to20 = True
bolBlock21 = True
End Select
End If
End Sub

Beliebteste Forumthreads (12 Monate)

Sperren trotz Freigabe geschützter Zellen

1 Beitrag zum Forumthread Beitrag zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

1
Beitrag zum Forumthread

Beitrag zu diesem Forumthread