Kleuren grafiekpunten aanpassen aan de kleur van broncellen

[reneemettrie]

Iemand legde me het volgende probleem voor. Zie geen oplossing, niet in Excel noch VBA.
De details weet ik niet maar komt op het volgende neer.
De cellen worden ingekleurd via voorwaardelijke opmaak. De gegevenspunten van de grafiek (hij maakt een kolomgrafiek) moeten dezelfde kleur hebben als de vulkleur. Zie de eerste 3 punten.
Maar hoe programmeer je de kleur die wordt bereikt via onditional formatting? Gaat niet via interior.color. Is dat wel mogelijk? Zo ja, dan denk ik dat je de kleuren op de grafiek kunt aanpassen, al dan niet met een lus.


Update
Heb er verder over nagedacht en denk dat ik dit moet doen:
Geen voorwaardelijke opmaak via Excel doen, maar celachtergrond programmeren met code.
Dan met een lus de kleur van de gegevenspunten laten overeenkomen met de respectievelijke cellen
Zou dat de oplossing zijn?

 

[Enigmasmurf]

Hoi Renée,

Het gaat inderdaad niet met interior.color, maar tenzij je met een antieke Office-versie werkt (wat ik dus niet verwacht) gaat het wel met "DisplayFormat.Interior.ColorIndex", je hoeft dan niet per se af te stappen van v.o.
Voor de verdere afhandeling zit je ongetwijfeld al op het juiste spoor.

Groetjes.

Update: net een klein proefje gedaan waaruit is gebleken dat het 'veiliger' is om Color te gebruiken i.p.v. ColorIndex.

 

[reneemettrie]

@Enigmasmurf:
Bedankt!
Heb het deze morgen geprobeerd zonder voorwaardelijke opmaak, dat werkte.
Maar weet niet welke condities hij gebruikt, en moet het snel tussendoor uitleggen/aanpassen in een basis opleiding...
Dus ik ga aan de slag met jouw suggestie!
Maar wat een miserie om de opmaak van een embedded chart aan te passen, lukte me niet zonder hulp van de recorder

Option Explicit

Sub test()
Dim r As Range, moyenne As Single, NrCells As Byte, Cel***e As Range
Dim Ch As Chart, Pt As Object, i As Byte
Set r = Range("A1").CurrentRegion.Columns(2)
NrCells = r.Cells.Count

Set r = r.Offset(1).Resize(NrCells - 1)


moyenne = WorksheetFunction.Average(r)

For Each Cel***e In r.Cells
If Cel***e.Value < moyenne Then
    Cel***e.Interior.Color = RGB(255, 0, 0)
ElseIf Cel***e.Value > moyenne Then
    Cel***e.Interior.Color = RGB(0, 255, 0)
Else
    Cel***e.Interior.Color = RGB(0, 0, 255)
End If
Next Cel***e

Set Ch = ActiveSheet.ChartObjects("Chart 2").Chart



 Ch.FullSeriesCollection(1).Points(1).Format.Fill.ForeColor.RGB = _
 r.Cells(1).Interior.Color
For i = 1 To NrCells - 1
Ch.FullSeriesCollection(1).Points(i).Format.Fill.ForeColor.RGB = _
 r.Cells(i).Interior.Color
'MsgBox i
Next i

End Sub