AW: Frage zum einfaerben
26.04.2020 10:56:51
hary
Moin
Ok, dann probier mal so.
Bei Doppelklick:
Sollte eine Zelle keine Farbe enthalten wird erstmal Rot. Anschliessend kannst du per Doppelklick wechseln zwischen Rot und Gruen.
Bei Rchtsklick:
Wird getauscht. Auch die Farbe.
Const Bereich As String = "D3:G10,I3:L10,N3:Q10,D14:G21,I14:L21,N14:Q21"
Public erste As String, zweite As String, ersteformel As String, zweiteformel As String
Public Farbe1, Farbe2
Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
If Not Intersect(Target, Range(Bereich)) Is Nothing Then
ActiveSheet.Unprotect Password:="hallo"
Cancel = True
If erste = "" Then
erste = Target.Address
ersteformel = Target.Cells(1).Formula
Farbe1 = Target.Cells(1).Interior.Color
End If
zweite = Target.Address
zweiteformel = Target.Cells(1).Formula
Farbe2 = Target.Cells(1).Interior.Color
If erste zweite And zweite "" Then
Application.EnableEvents = False
Range(erste).Cells(1).Formula = zweiteformel
Range(erste).Cells(1).Interior.Color = Farbe2
Range(zweite).Cells(1).Formula = ersteformel
Range(zweite).Cells(1).Interior.Color = Farbe1
erste = ""
zweite = ""
Farbe1 = -4142
Farbe2 = -4142
Application.EnableEvents = True
End If
ActiveSheet.Protect Password:="hallo"
End If
End Sub
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Not Intersect(Target, Range(Bereich)) Is Nothing Then
ActiveSheet.Unprotect Password:="hallo"
Cancel = True
With Target.Cells(1)
If .Interior.ColorIndex = -4142 Then
.Interior.Color = vbRed
Else
.Interior.Color = IIf(.Interior.Color = vbRed, vbGreen, vbRed)
End If
End With
ActiveSheet.Protect Password:="hallo"
End If
End Sub
gruss hary