mal wieder bedingte Formatierungen

Hallo Spezialisten,
ich habe folgendes Problem: mal wieder bedingte Formatierungen. In der Recherche fand ich folgenden Code (auf Seite von Hajo_Zi), den ich mir für die beiden fehlenden (4. und 5.) Bedingungen angepasst habe.
Der Code steht im Worksheet und arbeitet einwandfrei, solange das Blatt nicht mit einem Blattschutz versehen ist. Ist dieser aktiv kommt folgende Fehlermeldung:
Die ColorIndex-Eigenschaft des Interior-Objektes kann nicht festgelegt werden
Der Code:


Private Sub Worksheet_Calculate()
Dim RaBereich1 As Range, RaZelle1 As Range
' Bereich der Wirksamkeit AS1
Set RaBereich1 = Range("G23, I23, K23, M23, O23, Q23")
For Each RaZelle1 In RaBereich1
If Not Intersect(RaZelle1, RaBereich1) Is Nothing Then
Select Case RaZelle1.Value
Case "!"
RaZelle1.Interior.ColorIndex = 44
' orange
Case "0"
RaZelle1.Interior.ColorIndex = 36
' hell gelb
End Select
End If
Next RaZelle1
Set RaBereich1 = Nothing
End Sub

Kann mir jemand den Grund hierfür nennen und evtl sogar eine Abhilfe? Herzlichen Dank für Eure Mühe
Gruß
Johannes

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo johannes
versuchs mal so:
Das unprotect bzw. protect an die markierten stellen.
ungetestet.
Option Explicit
Private Sub Worksheet_Calculate()
    Dim RaBereich1 As Range, RaZelle1 As Range
    ' Bereich der Wirksamkeit AS1
    Set RaBereich1 = Range("G23, I23, K23, M23, O23, Q23")
    For Each RaZelle1 In RaBereich1
        If Not Intersect(RaZelle1, RaBereich1) Is Nothing Then
        'Hier unprotect
            Select Case RaZelle1.Value
                Case "!"
                    RaZelle1.Interior.ColorIndex = 44
                    ' orange
                Case "0"
                    RaZelle1.Interior.ColorIndex = 36
                    ' hell gelb
            End Select
        End If
    Next RaZelle1
    'Hier protect
    Set RaBereich1 = Nothing
End Sub
ransi

Private Sub Worksheet_Calculate() Dim RaBereich1 As Range, RaZelle1 As Range ' Bereich der Wirksamkeit AS1 ' Set RaBereich1 = Range("G24, I24, K24, M24, O24, Q24", "G25, I25, K25, M25, O25, Q25") Set RaBereich1 = Union(Range("G24, I24, K24, M24, O24, Q24"), _ Range("G25, I25, K25, M25, O25, Q25")) ActiveSheet.Unprotect ("") For Each RaZelle1 In RaBereich1 If Not Intersect(RaZelle1, RaBereich1) Is Nothing Then Select Case RaZelle1.Value Case "!" RaZelle1.Interior.ColorIndex = 44 ' orange Case "0" RaZelle1.Interior.ColorIndex = 36 ' hell gelb End Select End If Next RaZelle1 ActiveSheet.Protect ("") Set RaBereich1 = Nothing End Sub

Beliebteste Forumthreads (12 Monate)

mal wieder bedingte Formatierungen

12 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

12
Beiträge zum Forumthread

Beiträge zu diesem Forumthread