Grafiek (cirkel) - de kleuren van de originelen cellen terug laten komen in grafiek.

[Jane2812]

Ik heb een overzicht gemaakt in excel, waarvan een aantal onderwerpen een bepaalde kleur hebben gekregen. Dit overzicht vertaal ik naar verschillende grafieken. Deze grafieken nemen nu andere kleuren aan. Ik wil graag de grafieken de kleuren aannemen van de originele cel. Bijvoorbeeld:
Originele cellen staat het volgende:
Product
2A: Appels (kleur groen)
3A: Bananen (kleur geel)

Namen van personen
1B: Jan
1C: Klaas

Aantal per persoon/per product
2B: 15 (kleur groen)
3B: 28 (kleur geel)

2C: 30 (kleur groen)
3C: 6 (kleur geel)

Ik wil dan bijvoorbeeld een grafiek maken waarin een legenda staat van appels en bananen maar dan in de kleur van de originele cel (dus geel en groen). In de grafiek zou dan de verdeling moeten staan van hoeveel appels en hoeveel peren en in dezelfde kleur.

Dit even een hele simpele uitleg want mijn originele sheet is veel complexer met 8 onderwerpen en voor bijvoorbeeld 15 personen. Elk persoon moet dan zijn eigen grafiek krijgen met daarin een verdeling van de uitkomsten per onderwerp maar wel in dezelfde kleur.

Ik hoop dat het heel simpel is maar mijn zoektocht in excel heeft nog tot niets geleid. Hoop dat iemand kan helpen..

 

[SjonR]

Jane, een voorbeeldbestandje zou enorm helpen.

 

[Jane2812]

Jane, een voorbeeldbestandje zou enorm helpen.

Kan ik die hier ergens toevoegen?

 

[Jane2812]

Bijlage voorbeeld

Bekijk bijlage Voorbeeld grafiek.XLSX Hierbij een voorbeeld bestand. Ik heb nu even 1 grafiek toegevoegd. Je ziet ook een totaalgrafiek waarbij de kleuren wel zijn overgenomen, dit stond standard in een template. De grafieken per person wil ik zelf toevoegen, zoals er nu 1 staat. Bij deze lukt het dus niet om de kleuren automatisch over te nemen.

 

[HSV]

Bekend met macro's ?

Sub hsv()
Dim cl As Range, y As Long
For Each cl In Sheets("blad1").Range("h3:h10")
  y = y + 1
   Sheet1.ChartObjects(2).Chart.SeriesCollection(1).Points(y).Interior.Color = cl.Interior.Color
 Next cl
End Sub

 

[Jane2812]

Bekend met macro's ?

Sub hsv()
Dim cl As Range, y As Long
For Each cl In Sheets("blad1").Range("h3:h10")
  y = y + 1
   Sheet1.ChartObjects(2).Chart.SeriesCollection(1).Points(y).Interior.Color = cl.Interior.Color
 Next cl
End Sub

Nog niet! Dankjewel. Deze dus toevoegen als macro in de sheet?

 

[HSV]

Druk Alt+F11 → Menu Invoegen → module.
In het witte vlak rechts plak je de code.
Sluiten met Alt+F11 of Alt+Q of het kruisje.

Run de code door Alt+F8 → Uitvoeren.

Of hang de code aan een knop.

Bestand opslaan met macro's (.xlsm of .xlsb).

 

[Jane2812]

Druk Alt+F11 → Menu Invoegen → module.
In het witte vlak rechts plak je de code.
Sluiten met Alt+F11 of Alt+Q of het kruisje.

Run de code door Alt+F8 → Uitvoeren.

Of hang de code aan een knop.

Bestand opslaan met macro's (.xlsm of .xlsb).

Hi Harry,

Ik heb dit zojuist uitgevoerd maar hij past nu de grafiek aan naar helemaal geen kleuren. Kun jij zien welke module er is toegevoegd voor de eerste grafiek? Daar blijkt het namelijk wel te werken, zie Excel bestand die ik eerder heb toegevoegd.

Dank alvast! Zou heel fijn zijn als het lukt..

 

[HSV]

Het kan ook zonder Vba als je de legenda opmaakt.
Rechtermuisklik op de legenda (hoorn, viool, trompet, enz.) → legendagegeven opmaken → opvulling → automatisch.

Of de macro even twee keer laten lopen.
Eerste keer wordt alles wit, daarna constant de gewenste kleuren.

Sub hsv()
Dim y As Long
 For y = 1 To 8
  Sheet1.ChartObjects(2).Chart.SeriesCollection(1).Points(y).Format.Fill.BackColor.RGB = Cells(y + 2, 8).Interior.Color
 Next y
End Sub

Of:

Sub hsv()
Dim y As Long
 For y = 1 To 8
  With Sheet1.ChartObjects(2).Chart.SeriesCollection(1).Points(y)
    .Interior.ColorIndex = xlAutomatic
  End With
 Next y
End Sub