Addin

Sub procFormelzellenSchuetzen()
Dim rngAktiveZelle As Range
If MsgBox("Möchten Sie alle Formelzellen in diesem " & _
"Blatt schützen? Der Schutz für Zellen mit Zahlen " & _
"wird aufgehoben.", vbQuestion + vbYesNo, _
"Excel Weekly: Formeln schützen") = vbNo Then Exit Sub
On Error GoTo errorHandling
ActiveSheet.Unprotect
For Each rngAktiveZelle In ActiveSheet.UsedRange
If Not rngAktiveZelle.HasFormula And _
Not TypeName(rngAktiveZelle.Value) = "Date" And _
Application.IsNumber(rngAktiveZelle) Then
rngAktiveZelle.Locked = False
rngAktiveZelle.Font.ColorIndex = 5
Else
rngAktiveZelle.Locked = True
rngAktiveZelle.Font.ColorIndex = _
xlColorIndexAutomatic
End If
Next
ActiveSheet.Protect
Exit Sub
errorHandling:
MsgBox "Der folgende Fehler ist aufgetreten: " & _
Err.Number & " - " & Err.Description, vbCritical + _
vbOKOnly, "Excel Weekly: Formelzellen schützen"
End Sub