Sub Färbe(ByVal sBereich As String)
Dim rng As Excel.Range
Dim vntInput As Variant
Call ActiveSheet.Unprotect(Password:="KdoSAN")
Select Case Application.CommandBars.ActionControl.Caption
Case Is = "Eintrag löschen"
With Selection
.Interior.PatternColorIndex = xlNone
.Value = vbNullString
ActiveCell.Comment.Delete
End With
Case Is = "Bemerkung"
Do
vntInput = InputBox(Prompt:="Bitte etwas eingeben.", Title:="Eingabe")
If StrPtr(vntInput) = 0 Then Exit Sub
If Trim$(vntInput) = "" Then
Call MsgBox(Prompt:="Bitte etwas eingeben.", Buttons:=vbExclamation)
Else
Exit Do
End If
Loop
For Each rng In Selection
With rng
If Not .Comment Is Nothing Then Call .Comment.Delete
Call .AddComment(Text:=vntInput)
End With
Next
Case Else
For Each rng In Selection
With rng
.Interior.Color = Application.Names(sBereich).RefersToRange.Interior.Color
.Value = Application.Names(sBereich).RefersToRange.Value
End With
Next
End Select
End Sub