Cellen kleuren

Status
Niet open voor verdere reacties.

Ron001

Gebruiker
Lid geworden
4 dec 2017
Berichten
384
Allen

De code die in het toegevoegde bestand staat maakt cellen “WD”, “WN” geel en zet deze ook terug naar de beginkleur (verschil tss even en oneven weken ivm ranges/hoeveelheid personen)

* Kan deze macro korter worden
* Kan ik deze 2 macro’s onder één knop hangen, waarbij het indrukken van de knop de naam wordt gewijzigd? Bv: “OPVALLEND” en “STANDAARD” Toggle?
* Hoe komt het als ik .Font.bold inschakel macro suuuuupertraag wordt?
* Macro werkt alleen als cellen al gevuld zijn met “WD”, “WN”, kan ik er iets inzetten dat als de macro aanstaat en ik “WD”, “WN” toevoeg de cel ook gewijzigd wordt?

Bedankt!
 

Bijlagen

  • Kleuren cellen.xlsm
    58,4 KB · Weergaven: 42
* Hoe komt het als ik .Font.bold inschakel macro suuuuupertraag wordt?
Zet aan het begin Application.ScreenUpdating op False en aan het einde weer op True.

Wat het korter maken betreft heb je maar 1 Sub nodig die je aanroept waarbij je de Range en de kleur als Long mee geeft.
Als de cel wijzigt kan je Worksheet_Change gebruiken om er iets mee te doen.
 
Laatst bewerkt:
zo?

Code:
Sub Kleur_cel_naar_OPVALLEN()

If ActiveSheet.Buttons("Knop 1").Caption = "OPVALLEN" Then ActiveSheet.Buttons("Knop 1").Caption = "TERUG NAAR STANDAARD" Else ActiveSheet.Buttons("Knop 1").Caption = "OPVALLEN"

Dim cl As Range
Application.ScreenUpdating = False
For Each cl In Range("E16:AB59")
    Select Case UCase(cl.Value)
    Case "WD", "WN"
        If cl.Font.Bold Then cl.Font.Bold = False Else cl.Font.Bold = True
        If cl.Interior.Color = RGB(255, 255, 102) Then cl.Interior.Color = RGB(146, 208, 80) Else cl.Interior.Color = RGB(255, 255, 102)
    End Select
Next

End Sub

en deze:

Code:
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Value = "WD" Or Target.Value = "WN" Then
    Target.Font.Bold = True
    Target.Interior.Color = RGB(255, 255, 102)
Else
    Target.Font.Bold = False
    Target.Interior.Color = RGB(146, 208, 80)
End If
End Sub
 
@SjonR

Code:
Private Sub Worksheet_Change(ByVal Target As Range)
  Target.Font.Bold = instr("WDWN",target)
  Target.Interior.Color = iif(target.font.bold,RGB(255, 255, 102),RGB(146, 208, 80))
End Sub
 
Of:
Code:
Private Sub Worksheet_Change(ByVal Target As Range)
    Target.Font.Bold = InStr("WDWN", Target)
    Target.Interior.Color = IIf(Target.Font.Bold, 6750207, 5296274)
End Sub
 
@Edm

Bedoel je:

Code:
Private Sub Worksheet_Change(ByVal Target As Range)
    Target.Font.Bold = InStr("WDWN", Target)
    Target.Interior.Color = 5296274-target.font.bold*1453933
End Sub
 
Laatst bewerkt:
Haha!
Uiteraard bedoel ik dat! :D
 
Allen

Alvast bedankt voor de zeeer waardevolle input/hulp

Toch nog wat vraagjes (op het eerste zicht):

1) De code in event Private Sub Worksheet_Change(ByVal Target As Range) zou enkel moeten gelden als de macro "Sub OPVALLEN_kleuren()" aanstaat/opstaat (lees: op WEEKEND staat)


2) Kan ik hier(.Buttons("Knop 3").Caption) bv "Knop 4" bijvoegen, de knop moet hetzelfde doen maar staat op 2 verschillende sheets (even en oneven week)
3) Kan de cel in kolom B (naam medewerker) mee oplichten als er achter deze naam ergens WD/WN zou staan?

Heb van het overige dit gemaakt

Code:
Sub OPVALLEN_kleuren()

Application.ScreenUpdating = False

'RGB(255, 255, 102) = GEEL
'RGB(146, 208, 80) = GROEN
'RGB(191, 191, 191) = GRIJS

ActiveSheet.Buttons("Knop 3").Caption = IIf(ActiveSheet.Buttons("Knop 3").Caption = "WEEKEND", "STANDAARD", "WEEKEND")

ActiveSheet.Cells(3, 2).Select

' EVEN WEEK
If ActiveSheet.Cells(3, 2).Value Mod 2 = 0 Then

'GRIJS vroege en late ploeg


Dim cl As Range
    
For Each cl In Range("E16:AB26,E40:AB49")
    Select Case UCase(cl.Value)
    Case "WD", "WN"
        If cl.Font.Bold Then cl.Font.Bold = False Else cl.Font.Bold = True
        If cl.Interior.Color = RGB(255, 255, 102) Then cl.Interior.Color = RGB(191, 191, 191) Else cl.Interior.Color = RGB(255, 255, 102)
        
    End Select
Next

'GROEN vroege en late ploeg

Dim cl2 As Range
    
For Each cl2 In Range("E28:AB35,E51:AB58")
    Select Case UCase(cl2.Value)
    Case "WD", "WN"
        If cl2.Font.Bold Then cl2.Font.Bold = False Else cl2.Font.Bold = True
        If cl2.Interior.Color = RGB(255, 255, 102) Then cl2.Interior.Color = RGB(146, 208, 80) Else cl2.Interior.Color = RGB(255, 255, 102)
        
    End Select
Next

End If


' ONEVEN WEEK
If ActiveSheet.Cells(3, 2).Value Mod 2 <> 0 Then

'GRIJS vroege en late ploeg

Dim cl3 As Range
    
For Each cl3 In Range("E17:AB26,E40:AB50")
    Select Case UCase(cl3.Value)
    Case "WD", "WN"
        If cl3.Font.Bold Then cl3.Font.Bold = False Else cl3.Font.Bold = True
        If cl3.Interior.Color = RGB(255, 255, 102) Then cl3.Interior.Color = RGB(191, 191, 191) Else cl3.Interior.Color = RGB(255, 255, 102)
        
    End Select
Next
        
'GROEN vroege en late ploeg

Dim cl4 As Range
    
For Each cl4 In Range("E28:AB35,E52:AB59")
    Select Case UCase(cl4.Value)
    Case "WD", "WN"
        If cl4.Font.Bold Then cl4.Font.Bold = False Else cl4.Font.Bold = True
        If cl4.Interior.Color = RGB(255, 255, 102) Then cl4.Interior.Color = RGB(146, 208, 80) Else cl4.Interior.Color = RGB(255, 255, 102)
        
    End Select
Next

End If

Application.ScreenUpdating = True

End Sub
 
Laatst bewerkt:
Dan is dat dus de eerste test die je in Sub Worksheet_Change(ByVal Target As Range) moet doen.
 
Schrijf svp ipv

Code:
If ActiveSheet.Buttons("Knop 3").Caption = "WEEKEND" Then ActiveSheet.Buttons("Knop 3").Caption = "STANDAARD" Else ActiveSheet.Buttons("Knop 3").Caption = "WEEKEND"

Code:
If ActiveSheet.Buttons("Knop 3").Caption = "WEEKEND" Then 
   ActiveSheet.Buttons("Knop 3").Caption = "STANDAARD" 
Else 
   ActiveSheet.Buttons("Knop 3").Caption = "WEEKEND"
End if

Maar liever nog:

Code:
activeSheet.Buttons("Knop 3").Caption = iif(activeSheet.Buttons("Knop 3").Caption="WEEKEND","STANDAARD","WEEKEND")
of
Code:
With ActiveSheet.Buttons("Knop 3")
    .Caption = iif(.Caption="WEEKEND","STANDAARD","WEEKEND")
End With
 
@ Edmoor

Iets van

Code:
If call Sub OPVALLEN_kleuren() = True then
 
Hoe test ik of de macro "aanstaat"?

("Knop 3") bij deze heb ik ook al eens van gemaakt ("Knop 3, Knop 4") maar dit werkt niet? Valt dit aan twee verschillende te koppelen?
Ik weet dat ik ook gewoon twee knoppen kan maken, maar wou proberen deze éne macro aan twee knoppen te hangen...
 
Laatst bewerkt:
Daarvoor heeft MS de 'wisselknop' uitgevonden.
 
Ik zet alle cellen terug naar "Standaard" bij openen file...
Dit duurt zeker 10 seconden, maar gebruik de screenupdating manier om te onderdrukken, maar dit helpt niet?

*EDIT*
Opgelost => C.value=Ucase(C.value) over het hoofd gezien => vertraging.
 
Laatst bewerkt:
Status
Niet open voor verdere reacties.
Terug
Bovenaan Onderaan