Tekst categorielabels radar in verschillende kleuren

[HGPO]

Hoi!

Ik ben bezig met het maken van een radar, echter loop ik tegen een probleem aan.

De radar zoals op onderstaande afbeelding heb ik al ontworpen. Een radar waarbij ik de congruentie tussen vragenlijst + gedragsstijl wil aantonen.



De categorielabels staan nu allemaal in het donkerblauw, dus alle termen (bijv. bezorgdheid, ergernis, ontmoediging, sociaal zelfzeker enz.).
Graag wil ik de labels opdelen in domeinen. Dus bijv. de labels 'bezorgdheid' t/m 'kwetsbaarheid' de tekst in rood, van 'vriendelijkheid' t/m 'optimisme' groen en ga zo maar door.

Wie kan mij helpen om dit te realiseren? Ik heb al van alles geprobeerd, maar kom er niet aan uit. Van Visual Basic / Macro's heb ik helaas te weinig verstand.

Groet!

 

[Haije]

Welkom op Helpmij.nl!

ik zou beginnen met het posten van een excelbestand ipv een plaatje

 

[HGPO]

Hier het Excel-bestand waar het om gaat.

 

[E v R]

Bij sommige grafieken kun/kon je met 'dummy-labels' werken en deze een kleur geven, of dat bij een Radar kan...geen idee
Workaround, suggestie: Zet de achtergrond op transparant en plaats daarachter een plaatje waarin de gewenste kleuren in een cirkel in elkaar overlopen. (moet je wel even zo'n plaatje maken)

 

[E v R]

Cow18's code licht aangepast, volgens mij gaat het om de kleur van de Datalabels zelf, (samen met de lijnen geeft ook wel OK beeld)
geef de cellen in kolom A de gewenste kleur en draai de macro

Sub MijnKleuren2()
   Set mychart = Sheets("blad1").ChartObjects(1).Chart   'je grafiek
                             
      With mychart.FullSeriesCollection(2)   'bij een bepaalde serie
         sp = Split(Split(.Formula, ",")(2), "!")   'even het er bijbehorende bereik er bij zoeken
         Set c = Sheets(sp(0)).Range(sp(1)).Offset(0, -2)    'dat bereik
         For i = 1 To .Points.Count              'loopje door de punten
            Myrgb = wRGB(c.Cells(i))             'vraag de RGB-kleur van een bepaalde cel
            .DataLabels(i).Font.Color = rgb(Myrgb(0), Myrgb(1), Myrgb(2))
            Next
      End With
End Sub

Function wRGB(rng As Range)
   Dim intColor As Long
   Dim rgb     As String
   intColor = rng.Interior.Color
   r = intColor And 255
   g = intColor \ 256 And 255
   b = intColor \ 256 ^ 2 And 255
   If r + g + b = 3 * 255 Then g = 0: b = 0      'indien geen kleur (RGB = 255,255,255) dan RGB(255,0,0) = rood
   wRGB = Array(r, g, b)
End Function

 

[HGPO]

Thanks voor het meedenken, super dat jullie me op weg proberen te helpen.

Ik heb de cellen in kolom A de gewenste kleur gegeven en de laatst genoemde macro gedraaid.
Krijg dan de volgende foutmelding. Wat doe ik verkeerd?

 

[E v R]

Code werkt wel in cow18's bestandje, even de verschillen zoeken, ik kan het niet vinden...
De grafiek in het bestand van cow18 werkt wel, wellicht gemaakt in andere versie? Andere grafiek aangemaakt?
de DataLabels zijn daarin wel op te vragen....kopieer anders die grafiek eens in jouw bestand.

 

[HGPO]

Thx wederom voor het meedenken.

Heb die regel van Cow aangepast.

Foutmelding laat nu het volgende zien:

Sorry, maar ik ben dus echt een dummy blijkbaar....

 

[E v R]

Een aantal handmatige handelingen, je hoeft dit immers niet iedere keer te doen:

In jouw oorspronkelike bestandje:

In kolom D

• naam Dummy in D1
• formule in iedere cel in het bereik d2 tot d29
• =MAX($B$2:$C$29)
• Pas het grafiek bereik aan naar =Blad1!$A$1:$D$29
• Verwijder in Legenda Dummy ( 2 keer op linkermuis, dan rechtermuis en delete)
• Onder Chart tools, design kies
• Add Chartelement, Datalabel
• kies Show
• Verwijder de nummers IN de radar zelf, behalve het verticale lijntje van 0 tot 9
• Pas de dikke buitenste lijn aan naar "no line"
• Selecteer de Radaraxislabels (de namen van het gedrag)
• En verwijder deze
• geef de cellen in kolom A de juiste kleur
• Plaats onderstaande macro in een module en draai deze

Sub MijnKleuren3()
   Set mychart = Sheets("blad1").ChartObjects(1).Chart   'je grafiek
                             
      With mychart.FullSeriesCollection(3)   'bij een bepaalde serie
         sp = Split(Split(.Formula, ",")(2), "!")   'even het er bijbehorende bereik er bij zoeken
         Set c = Sheets(sp(0)).Range(sp(1)).Offset(0, -3)    'dat bereik
         For i = 1 To .Points.Count              'loopje door de punten
            Myrgb = wRGB(c.Cells(i))             'vraag de RGB-kleur van een bepaalde cel
            .DataLabels(i).Format.TextFrame2.TextRange = c.Cells(i)
            .DataLabels(i).Format.TextFrame2.TextRange.Characters.Font.Fill.ForeColor.rgb = rgb(Myrgb(0), Myrgb(1), Myrgb(2))
            Next
      End With
End Sub

Function wRGB(rng As Range)
   Dim intColor As Long
   Dim rgb     As String
   intColor = rng.Interior.Color
   r = intColor And 255
   g = intColor \ 256 And 255
   b = intColor \ 256 ^ 2 And 255
   If r + g + b = 3 * 255 Then g = 0: b = 0      'indien geen kleur (RGB = 255,255,255) dan RGB(255,0,0) = rood
   wRGB = Array(r, g, b)
End Function

 

[E v R]

Dag Bart,

Yep, de categorienaam had ook al handmatig aangevinkt kunnen worden zie ik nu , de kleuren aanpassen kan ook handmatig, wellicht is een macrootje zelfs overbodig :d :thumb: