Private Sub Workbook_SheetChange(ByVal sh As Object, ByVal Target As Range)
Debug.Print "Beginn"
Static bDoIng As Boolean
If Not bDoIng Then
bDoIng = True
Debug.Print "Beginn Intern"
Dim rng As Range
Set rng = getProtectedRange
If Not Intersect(Target, rng) Is Nothing Then
Debug.Print "A"
With Target
ActiveSheet.Unprotect Password:="123"
.Cells(Target.Row, 3).Value = Format(Date, "dd.mm.yyyy")
.Cells(Target.Row, 3).Locked = True
Target.Locked = True
ActiveSheet.Protect Password:="123"
End With
End If
bDoIng = False
End If
End Sub
Function getProtectedRange() As Range
Dim rngProtect As Range
Dim nm As Name
Dim sRngs() As String
Set nm = ActiveWorkbook.Names("Schutz")
Dim sRng As String, iPos As Integer
sRng = nm.RefersTo
If InStr(sRng, ",") > 0 Then
sRngs = Split(sRng, ",")
Set rngProtect = Range(sRngs(0))
For iPos = 1 To UBound(sRngs)
Set rngProtect = Union(rngProtect, Range(sRngs(iPos)))
Next
Else
Set rngProtect = nm.RefersToRange
End If
Set getProtectedRange = rngProtect
End Function