Zellfarbe (Ampel) ändern Makro

Private Sub worksheet_beforedoubleclick(ByVal target As Range, cancel As Boolean) If ActiveCell.Interior.ColorIndex = xlNone Then ' keine ActiveCell.Interior.ColorIndex = 35 ' grün Else If ActiveCell.Interior.ColorIndex = 35 Then ActiveCell.Interior.ColorIndex = 39 ' gelb Else If ActiveCell.Interior.ColorIndex = 39 Then ActiveCell.Interior.ColorIndex = 49 ' rot Else If ActiveCell.Interior.ColorIndex = 49 Then ActiveCell.Interior.ColorIndex = xlNone End If End If End If End If cancel = True End Sub

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Benutzer

Hallo Karl,

Option Explicit
Private Sub worksheet_beforedoubleclick(ByVal target As Range, cancel As Boolean)
Dim RaBereich As Range
' Bereich der Wirksamkeit
Set RaBereich = Range("L22:M39, O21:O26")
' noch mehr Bereiche
'Set RaBereich = Union(Range("C11:AG11 , C13:AG13, C15:AG15 , C17:AG17 , C19:AG19 ,  C21: _
AG21 , C27:AE27 , C29:AE29, C31:AE31, C33:AE33"), _
'    Range("C35:AE35, C37:AE37, C43:AG43, C45:AG45 , C47:AG47 , C49:AG49 ,C51:AG51 , C53: _
AG53 , C59:AF59 , C61:AF61 , C63:AF63 , C65:AF65"), _
'    Range("C67:AF67 , C69:AF69 , C75:AG75 , C77:AG77 , C79:AG79 , C81:AG81 , C83:AG83 ,  _
C85:AG85 ,C91:AF91 , C93:AF93 , C95:AF95 , C97:AF97"), _
'    Range("C99:AF99 , C101:AF101, C107:AG107 , C109:AG109 , C111:AG111 , C113:AG113 , C115: _
AG115 , C117:AG117 , C123:AG123 , C125:AG125"), _
'    Range("C127:AG127 , C129:AG129 , C131:AG131 , C133:AG133 , C139:AF139 , C141:AF141 ,  _
C143:AF143 , C145:AF145 , C147:AF147 , C149:AF149"), _
'    Range("C155:AG155, C157:AG157 , C159:AG159 , C161:AG161 , C163:AG163 , C165:AG165 ,  _
C171:AF171 , C173:AF173 , C175:AF175 , C177:AF177 "), _
'    Range("C179:AF179 , C181:AF181, C187:AG187 , C189:AG189 , C191:AG191 , C193:AG193 ,  _
C195:AG195 , C197:AG197"))
' ab Vesion XP braucht der Schutz nicht aufgehoben werden
' Formatierung bei Schutz kann über Dialog Schutz eingestellt werden
' Zelle die in dem Bereich liegen auf die Varible schreiben
' damit werden nur noch die Zellen bearbeitet die im vorgegeben Bereich liegen
' jede Zelladresse ist einzeln angegeben
Set RaBereich = Intersect(RaBereich, Range(target.Address))
If Not RaBereich Is Nothing Then
If ActiveCell.Interior.ColorIndex = xlNone Then         ' keine
ActiveCell.Interior.ColorIndex = 35                  ' grün
ElseIf ActiveCell.Interior.ColorIndex = 35 Then
ActiveCell.Interior.ColorIndex = 39              ' gelb
ElseIf ActiveCell.Interior.ColorIndex = 39 Then
ActiveCell.Interior.ColorIndex = 49          ' rot
ElseIf ActiveCell.Interior.ColorIndex = 49 Then
ActiveCell.Interior.ColorIndex = xlNone
End If
cancel = True
End If
End Sub

Hallo Hajo,
schau doch mal auf die Uhrzeit, aus Deinen Beiträgen weiss ich, das Du nicht blind bist;-)
Während ich meine Antwort geschrieben habe, hast Du, unbemerkt von mir, Deine Antwort gepostet. Und da mein Beitrag OT ist, habe ich höflicherweise die Frage offen gelassen.
Was mir an Deiner Art der Frage allgemein überhaupt nicht gefällt Hajo, ist die Ausdrucksweise. Auch wenn es nicht so gemeint ist (hoffe ich), den Ausdruck "glaubst Du...."(hier glücklicherweise ohne den Zusatz "wirklich") vermittelt doch schon ein sehr arrogantes Auftreten, das vermittelt dem Leser, der Angesprochene leidet ein wenig unter Beschränktheit. Mich kratzt das nicht, ich kenne Deine Art hier, aber als MVP (und "Moderator") sollte man schon ein wenig auf das achten was man schreibt und wie es interpretiert werden kann.
MfG Christian
MfG Christian

Beliebteste Forumthreads (12 Monate)

5 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

5
Beiträge zum Forumthread

Beiträge zu diesem Forumthread