Celkleur veranderen met 1 muisklik

[wuta]

Hallo allen,
zie bijgevoegd excel bestandje

Is het mogelijk dat wanneer je met 1 muisklik op A1 of A2 de celkleur steeds veranderd in blauw of rood?
En dat je vervolgens geen getallen ziet (verborgen) in de cel maar wel de formules bewaart voor E1?
Dan is rood altijd nul en blauw vijftien.

alvast bedankt grt Niels

 

[Cobbe]

Zet dit in je werkbladcode:

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
  If Target.Cells.Interior.ColorIndex = 3 Then Target.Cells.Interior.ColorIndex = 23: Exit Sub
   If Target.Cells.Interior.ColorIndex = 23 Then Target.Cells.Interior.ColorIndex = 3
End Sub

 

[popipipo]

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
        If Not Intersect(Target, Range("A1:B1")) Is Nothing Then
            If Target.Value = "" Then
               Target.Value = "0"
                  ElseIf Target.Value = "0" Then
                         Target.Value = "15"
            Else
                Target.Value = "0"
            End If
            Target.Offset(1, 0).Select
        End If
End Sub

Of dit en dan de kleur regelen via voorwaardelijke opmaak

 

[HSV]

Of:
Maak ook gebruik van 'cancel = true'.

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Not Intersect(Target, Range("a1:b1")) Is Nothing Then
  With Target
   .Interior.ColorIndex = IIf(.Interior.ColorIndex = 3, 23, 3)
   .Font.ColorIndex = .Interior.ColorIndex
   .Value = IIf(.Interior.ColorIndex = 3, 0, 15)
  End With
  Cancel = True
 End If
End Sub

 

[wuta]

Bedankt voor de snelle reacties.
Ben nog aan het stoeien om deze oplossingen in het vba te verwerken en draaiend te krijgen (ben een beginneling)

 

[HSV]

Alt+F11 → dubbelklik in projectvenster op Blad1 (Blad1), en plak de code in het grote witte vlak.

 

[wuta]

Ben even weg geweest en kwam terug en lukte direct en werkt bijna zoals ik gevraagd had...superbedankt
alleen is de dubbelklik ook te vervangen door een enkele klik?

 

[VenA]

Bij één muisklik heb je het SelectionChange event nodig. Maar deze reageert ook op het selecteren van een cel dmv het toetsenbord.

Met de code van HSV krijg je dan zoiets.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Not Intersect(Target, Range("a1:b1")) Is Nothing Then
    Application.EnableEvents = False
    With Target
        .Interior.ColorIndex = IIf(.Interior.ColorIndex = 3, 23, 3)
        .Font.ColorIndex = .Interior.ColorIndex
        .Value = IIf(.Interior.ColorIndex = 3, 0, 15)
    End With
    Application.EnableEvents = True
End If
End Sub

Beide codes staan in het bestandje.

 

[wuta]

Hier kan ik wat mee!!
bedankt allemaal