• Privacywetgeving
    Het is bij Helpmij.nl niet toegestaan om persoonsgegevens in een voorbeeld te plaatsen. Alle voorbeelden die persoonsgegevens bevatten zullen zonder opgaaf van reden verwijderd worden. In de vraag zal specifiek vermeld moeten worden dat het om fictieve namen gaat.

cel kleuren dmv formule

Status
Niet open voor verdere reacties.
E

elvisP

Gebruiker
Lid geworden
5 nov 2008
Berichten
8
Hallo,

Ik zal meteen met de deur in huis vallen.

Kan ik met een formule een cel een kleur geven als een andere cel, waar de formule naar verwijst, aan een bepaalde voorwaarde voldoet?

Bv:

a1 op blad 1 moet rood kleuren als a1 op blad 2 de tekst "rood" bevat.

Is dit mogelijk?

alvast bedankt
 
elvisP zei:
Hallo,

Ik zal meteen met de deur in huis vallen.

Kan ik met een formule een cel een kleur geven als een andere cel, waar de formule naar verwijst, aan een bepaalde voorwaarde voldoet?

Bv:

a1 op blad 1 moet rood kleuren als a1 op blad 2 de tekst "rood" bevat.

Is dit mogelijk?

alvast bedankt
Klik om te vergroten...

Ja, maar niet via een formule, maar via Voorwaardelijke opmaak.

Met vriendelijke groet,


Roncancio
 
Ik vermoedde al zoiets, echter de cel waar het om gaat kan 5 verschillende teksten bevatten.
En aangezien voorwaardelijk opmaak niet verder gaat dan 3 opties, houdt dat op.

het zou zoiets als dit moeten zijn:

Als blad2!a1="wit";wit kleuren;als blad2!a1="rood"; rood kleuren;als blad2!a1="groen"; groen kleuren;als blad2!a1="blauw"; blauw kleuren;als blad2!a1="geel";geel kleuren

Als dit in VBA kan is het ook goed maar daar ben ik niet zo'n grote ster in.
 
Ja, dit moet in VBA, dus probeer maar eens wat uit. Gebruik de zoekfunctie op het forum, want deze vraag is al vaak gesteld geweest.
 
Een simpel stukje code voor blad2:
Code: 
Private Sub Worksheet_Deactivate()
Select Case Worksheets("Blad2").Range("A1").Value
    Case "wit"
        Worksheets("Blad1").Range("A1").Interior.Color = vbWhite
    Case "rood"
        Worksheets("Blad1").Range("A1").Interior.Color = vbRed
    Case "blauw"
        Worksheets("Blad1").Range("A1").Interior.Color = vbBlue
    Case "groen"
        Worksheets("Blad1").Range("A1").Interior.Color = vbGreen
    Case "geel"
        Worksheets("Blad1").Range("A1").Interior.Color = vbYellow
End Select
End Sub

Met vriendelijke groet,


Roncancio
 
Hoe simpel ook, het werkt wel.
Nu moet ik hem nog zover krijgen dat deze fuchtie wordt uitgevoerd bij een wijziging van blad2 A1.
Is daar iets voor?

Bedankt!
 
Code voor Blad 2

Code: 
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = Range("A1").Address Then
    Select Case Range("A1").Value
    Case "wit"
        Worksheets("Blad1").Range("A1").Interior.Color = vbWhite
    Case "rood"
        Worksheets("Blad1").Range("A1").Interior.Color = vbRed
    Case "blauw"
        Worksheets("Blad1").Range("A1").Interior.Color = vbBlue
    Case "groen"
        Worksheets("Blad1").Range("A1").Interior.Color = vbGreen
    Case "geel"
        Worksheets("Blad1").Range("A1").Interior.Color = vbYellow
End Select
End If
End Sub

Mvg

Rudi
 
Laatst bewerkt:
Rudi,

Dat is 'm niet hoor.
Het werkte eerst alleen bleef het niet maar heb hem aangepast op jou wijze en nu doet ie niets meer.

elvisP
 
elvisP, ik ben er meer dan zeker van dat hij het wel doet.;) Waar heb je de code geplaatst?
Kopiëer de formule >> klik op de tab van Blad2 >> selecteer Programmacode weergeven en plak de code
Bij het wijzigen van cel A1 van Blad2 wijzigt nu de kleur van cel A1 van Blad1 net zoals voordien.
Mvg

Rudi
 
Laatst bewerkt:
Ik denk dat ik ergens een foutje heb.
De code is natuurlijk aangepast voor gebruik in mijn bestand:
Code: 
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = Range("A1").Address Then
Select Case Worksheets("GEGEVENS").Range("A49").Value
    Case "WIT"
        Worksheets("INDELING").Range("C4:IV4").Interior.Color = vbWhite
    Case "ROOD"
        Worksheets("INDELING").Range("C4:IV4").Interior.Color = vbRed
    Case "BLAUW"
        Worksheets("INDELING").Range("C4:IV4").Interior.Color = vbBlue
    Case "GROEN"
        Worksheets("INDELING").Range("C4:IV4").Interior.Color = vbGreen
    Case "GEEL"
        Worksheets("INDELING").Range("C4:IV4").Interior.Color = vbYellow
End Select
End If
End Sub
Kan het zijn dat de range in
Code: 
If Target.Address = Range("A1").Address Then
gewijzigd moet worden?
Ik heb er nl A49 van gemaakt maar dan gebeurd er niets.
 
Code: 
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = Range("A49").Address Then
Select Case Trim$(UCase(Worksheets("GEGEVENS").Range("A49").Value))
    Case "WIT"
        Worksheets("INDELING").Range("C4:IV4").Interior.Color = vbWhite
    Case "ROOD"
        Worksheets("INDELING").Range("C4:IV4").Interior.Color = vbRed
    Case "BLAUW"
        Worksheets("INDELING").Range("C4:IV4").Interior.Color = vbBlue
    Case "GROEN"
        Worksheets("INDELING").Range("C4:IV4").Interior.Color = vbGreen
    Case "GEEL"
        Worksheets("INDELING").Range("C4:IV4").Interior.Color = vbYellow
End Select
End If
End Sub

Met bovenstaande code werkt het bij mij wel.
Zodra een een kleur is ingetoetst wordt het bereik gevuld met die kleur.
Er wordt nu ook rekening gehouden met hoofdletters en spaties.
Wellicht dat het daardoor misging.

Met vriendelijke groet,


Roncancio
 
Als ik hem in een lege werkmap zet doet ie het perfect, kom ik net achter.
Echter in mijn eigen bestand gebeurd er nog steeds niets.

In cel A49 van GEGEVENS! staat 1 van de kleuren ingevuld.
 
elvisP zei:
Als ik hem in een lege werkmap zet doet ie het perfect, kom ik net achter.
Echter in mijn eigen bestand gebeurd er nog steeds niets.

In cel A49 van GEGEVENS! staat 1 van de kleuren ingevuld.
Klik om te vergroten...

GEGEVENS of GEGEVENS! ?
Dus met of zonder uitroepteken?

Met vriendelijke groet,


Roncancio
 
Code: 
Private Sub Worksheet_Change(ByVal Target As Range)
   If Target.Address = "$A$49" Then sheets("INDELING").[C4:IV4].Interior.Color = Switch(lcase([A49]) = "wit", vbWhite, lcase([A49])  = "rood", vbRed, lcase([A49])  = "blauw", vbBlue, lcase([A49]) = "groen", vbGreen, lcase([A49])  = "geel", vbgeel)
End sub
Deze code moet in het werkblad staat dat de te wijzigen cel A49 bevat (sheets('gegevens") in jouw geval).

Maar het is natuurlijk veel eenvoudiger om de kleur van A49 te wijzigen.
De opdracht wordt dan
Code: 
sheets("INDELING").[C4:IV4].Interior.Color = [A49].interior.color
 
De code staat in GEGEVENS.
De kleur van A49 is blanco, alleen de tekst in deze cel verandert.
Deze verandert in WIT, BLAUW, GEEL, ROOD en GROEN.
Dus is de bedoeling dat de range C4:IV4 in INDELING verandert naar de kleur die staat ingevuld in GEGEVENS A49.

Met de eerste code van Roncancio werkte dat ook.
Echter als ik de tekst een 2e maal veranderde gebeurde er niet totdat de code opnieuw gecompileerd werd, bv door het bestand opnieuw te openen.

Dus leek het me makkelijk als dat automatisch ging, vandaar de code van Rudi, die heel goed werkt op een leeg werkblad maar als ik deze integreer in de mijne doet ie niets meer.

Ik za hieronder de codes van de tabbladen plaatsen:

INDELING
Code: 
Option Explicit

Private Sub Worksheet_activate()
On Error Resume Next
Dim GoToDate As Range
Dim Mydate As Date
Mydate = Date
    Application.Goto Reference:=Worksheets("INDELING").Cells(2, 3)
        With Sheets("INDELING").UsedRange.Rows(2)
            Set GoToDate = .Find(Mydate).Cells
            If GoToDate <> Mydate Then Set GoToDate = .Find(Mydate + 1).Cells
                If GoToDate <> Mydate And GoToDate <> Mydate + 1 Then Set GoToDate = .Find(Mydate + 3).Cells
        End With
    GoToDate.Select
    ActiveWindow.SmallScroll ToRight:=3
End Sub
GEGEVENS
Code: 
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = Range("A49").Address Then
Select Case Trim$(UCase(Worksheets("GEGEVENS").Range("A49").Value))
    Case "WIT"
        Worksheets("INDELING").Range("C4:IV4").Interior.Color = vbWhite
    Case "ROOD"
        Worksheets("INDELING").Range("C4:IV4").Interior.Color = vbRed
    Case "BLAUW"
        Worksheets("INDELING").Range("C4:IV4").Interior.Color = vbBlue
    Case "GROEN"
        Worksheets("INDELING").Range("C4:IV4").Interior.Color = vbGreen
    Case "GEEL"
        Worksheets("INDELING").Range("C4:IV4").Interior.Color = vbYellow
End Select
End If
End Sub
This Workbook
Code: 
Sub AFDRUKINDELING()

With Sheets("INDELING")
  .PageSetup.PrintArea = .Rows(2).Find(Date).Resize(50, 14).Address
  .PageSetup.PrintArea = .Rows(2).Find(Format(Date, "dd-mm-yyyy")).Resize(50, 14).Address
   .PageSetup.PrintArea = .Rows(2).Find(CDbl(Date)).Resize(50, 14).Address
End With
End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)
    ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True, Password:="*****"
    ActiveSheet.EnableSelection = xlNoSelection
    Sheets("GEGEVENS").Select
    ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True, Password:="*****"
    ActiveSheet.EnableSelection = xlNoSelection
    Sheets("ADRESSEN").Select
    ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True, Password:="*****"
    ActiveSheet.EnableSelection = xlNoSelection
    Sheets("VAKANTIEROOSTER").Select
    ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True, Password:="*****"
    ActiveSheet.EnableSelection = xlNoSelection
    Sheets("ATR CORRECTIE").Select
    ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True, Password:="*****"
    ActiveSheet.EnableSelection = xlNoSelection
    Sheets("MAANDRAPPORTAGE").Select
    ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True, Password:="*****"
    ActiveSheet.EnableSelection = xlNoSelection
    Sheets("INDELING").Select
    ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True, Password:="*****"
    ActiveSheet.EnableSelection = xlNoSelection
    Sheets("HOOFDMENU").Select
    With ThisWorkbook
 If Not .Saved Then
  .Save
 End If
End With
With Application
 If .Workbooks.Count = 1 Then
  .Quit
 End If
End With

End Sub
 
Ik heb al je code in een bestand geplaatst en het blijft bij mij gewoon werken.
(zie bijlage)

Met vriendelijke groet,


Roncancio
 

Bijlagen

Status
Niet open voor verdere reacties.
                    Steun ons                    

Nieuwste berichten

Terug
Bovenaan Onderaan