celkleur via code

[rob91]

Hallo,

Ik heb op het forum tussen de vele antwoorden over cel kleuren deze code gevonden en aangepast aan mijn sheet. Helaas werkt deze niet. Wat doe ik fout?

De bedoeling is dus als er een van de volgende waardes (Z,ZM,ZV in een cel in de range ingevuld wordt moet de cel van kleur wijzigen.

(Ik kan het niet via voorwaardelijke opmaak regelen want die 3 mogelijkheden zijn al in gebruik voor andere zaken.)

Rob


Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Address = Range("F27:AJ37").Address Then
Select Case ActiveCell.Value
Case "ZM"
ActiveCell.Interior.ColorIndex = 41
Case "Z"
ActiveCell.Interior.ColorIndex = 39
Case "ZV"
ActiveCell.Interior.ColorIndex = 6
Case Else
ActiveCell.Interior.ColorIndex = xlNone
End Select
End If
End Sub

 

[danny147]

Beste rob91

Ben je hier iets mee ?

Groetjes Danny. :thumb:

 

[rob91]

Hallo Danny,

Jouw oplossing werkt....maar ik zie alleen dat in je code staat [screen updating is false] maar mijn overzicht "klappert" als ik een waarde in een cel zet.
Is daar nog wat aan te doen??

Rob

 

[danny147]

Beste rob91

Na de Sub plaats je

Application.ScreenUpdating = False

Voor de End Sub plaats je

Application.ScreenUpdating = True

Dit gaat het flikkeren tegen gaan.

Groetjes Danny. :thumb:

 

[rob91]

Beste Danny,

Dit heb ik er nu als code in de sheet staan, maar deze flikkert nog steeds.

Private Sub Worksheet_Change(ByVal Target As Range)
Application.ScreenUpdating = False
If Not Intersect(Target, Range("F26:AJ37")) Is Nothing Then
Range("J46").Value = Date
Range("J49").Value = Application.UserName
End If
'http://www.mvps.org/dmcritchie/excel/colors.htm'
Dim cell_in_loop As Range
For Each cell_in_loop In Range("F26:AJ37")
With cell_in_loop
Select Case .Value
Case "Z": .Interior.ColorIndex = 3
Case "ZM": .Interior.ColorIndex = 3
Case "ZV": .Interior.ColorIndex = 22
Case "z": .Interior.ColorIndex = 3
Case "zm": .Interior.ColorIndex = 3
Case "zv": .Interior.ColorIndex = 22
Case "": .Interior.ColorIndex = 2

End Select
End With
Next
Application.ScreenUpdating = True
End Sub

 

[snb]

Private Sub Worksheet_Change(ByVal Target As Range)
  Application.ScreenUpdating = False
  If Not Intersect(Target, Range("F26:AJ37")) Is Nothing Then
    Range("J46").Value = Date
    Range("J49").Value = Application.UserName

    With target.interior
      .Colorindex=2
      Select Case ucase(.parent.Value)
      Case "Z","ZM"
        .ColorIndex = 3
      Case "ZV"
        .ColorIndex = 22
      End Select
    End With
  End If
  Application.ScreenUpdating = True
End Sub

 

[rob91]

Hallo SNB,

Code is mooi compact geworden, maar....... mijn scherm flikkert nog steeds een keer of 5 als ik een waarde invoer. Kan dit ook veroorzaakt worden door de voorwaardelijke opmaak die ik via de functie voorwaardelijke opmaak erin heb staan?

En is het ook mogelijk dat invoer van kleine letters automatisch naar hoofdletters gezet wordt?

 

[snb]

Tis of het een of het ander. Haal die voorwaardelijke opmaak er eerst maar eens uit en beoordeel het resultaat.

 

[rob91]

Het ligt toch echt aan de code, want als ik deze code deactiveer en alleen de voorwaardelijke opmaak heb, gaat het goed en andersom niet; dus wel met code en zonder voorwaardelijke opmaak flikkert het scherm zodra ik de cel selecteer.

Rob

 

[snb]

zodra ik de cel selecteer

dan doet de code (Private Sub Worksheet_Change(ByVal Target As Range))
nog helemaal niks. Pas als je de cel hebt gewijzigd en afsluit.
Contoleer of er niet nog ergens anders code geactiveerd wordt.

 

[Warme bakkertje]

Rob, probeer deze eens

Private Sub Worksheet_Change(ByVal Target As Range)
  Application.ScreenUpdating = False
  Application.EnableEvents = False
  If Not Intersect(Target, Range("F26:AJ37")) Is Nothing Then
    Target = UCase(Target)
    Range("J46").Value = Date
    Range("J49").Value = Application.UserName
    With Target.Interior
      .ColorIndex = 2
      Select Case UCase(.Parent.Value)
      Case "Z", "ZM"
        .ColorIndex = 3
      Case "ZV"
        .ColorIndex = 22
      End Select
    End With
  End If
  Application.EnableEvents = True
  Application.ScreenUpdating = True
End Sub

Mvg

Rudi

 

[rob91]

Rudi,

Ik blijf het probleem houden dat al bij selectie van de cel het scherm knippert, terwijl dat toch pas bij wijziging van de celinhoud zou moeten gebeuren.

bestand maar bijgevoegd; mischien kan iemand ontdekken waar het probleem zit

Rob.

 

[snb]

Ik tref geen bestand in het zip-bestand aan.

 

[rob91]

nieuwe poging...........

Rob

 

[snb]

verwijder de gebeurtenisproceudre
Private Sub Worksheet_SelectionChange(ByVal Target As Range)

In werkblad kalender.

Deze suggestie had ik al eerder gedaan.

 

[rob91]

Hallo snb,

Dat is inderdaad de oplossing. Ik had dat eerder niet zo begrepen.

maar deze code is van crusiaal belang voor het tellen van de ziektedagen en ziekmeldingen.

Zie je daar dan een andere oplossing voor?

Rob

 

[snb]

Ik begrijp niet hoe kunt testen op interiorcolor = vbred zonder de waarde "ZM", omdat alle cellen zonder "ZM" in jouw code de kleur 2 krijgen.

Wat wel kan

Private Sub Worksheet_Change(ByVal Target As Range)
  Application.ScreenUpdating = False
  If Not Intersect(Target, Range("F26:AJ37")) Is Nothing Then
    Target = UCase(Target)
    Range("J46").Value = Date
    Range("J49").Value = Application.UserName
    
    With Target.Interior
      .ColorIndex = 2
      Select Case UCase(.Parent.Value)
      Case "Z", "ZM"
        .ColorIndex = 3
      Case "ZV"
        .ColorIndex = 22
      End Select
    End With
    For Each c In Range("F26:AJ37")
      If c.Value = "ZM" Then x = x + 1
    Next
    [AK41] = x
  End If
  Application.ScreenUpdating = True
End Sub

 

[rob91]

snb,

De opzet was dat er geteld worden hoeveel cellen er zijn met ZM en hoeveel rode cellen er totaal zijn.
Nu heb ik eigenlijk mijn methode al aangepast en krijgt de cel bij ziekmelding de rode kleur en ZM en de volgende ziektedagen de rode kleur en Z . Dit omdat ik een probleem kreeg met het overnemen van de kleur naar mijn algemene overzichtsmap met de gegevens van alle medewerkers. Een waarde is dan makkelijker .

Mijn probleem is opgelost door alleen code onder [worksheet_change] te zetten.
Bedankt voor je hulp.:thumb:

Rob