VBA: Extracting the RGB value of lines in a chart with default colors

匿名 (未验证) 提交于 2019-12-03 02:56:01

问题:

Problem

I would like to know how to read the current RGB value of an automatically assigned color in a chart, even if this entails freezing the colors to their current values (rather than updating them as the theme is changed, series are reordered, etc.)

Usecase

My actual usecase is that I would like to make the datalabels match the color of the lines/markers in a line chart. This is easy if I have explicitly set the colors of the series via a scheme or explicit RGB values, e.g.

' assuming ColorFormat.Type = msoColorTypeRGB s.DataLabels.Format.TextFrame2.TextRange.Font.Fill.ForeColor.RGB= _ s.Format.Line.ForeColor.RGB 

However, doing this when the series color is assigned automatically results in white labels. More specifically, both of the following equalities hold

s.Format.Line.ForeColor.Type = msoColorTypeRGB  s.Format.Line.ForeColor.RGB = RGB(255,255,255)  ' White 

And yet the line of course isn't white, but is an automatically assigned color from the theme. This shows that the color is automatically assigned

s.Border.ColorIndex = xlColorIndexAutomatic 

I suppose it makes sense that the color isn't stored with the series in question. Even storing the index into the color scheme wouldn't generally work as Excel needs to change the color if another data series is added or someone reorders the data. Still, I would love it if there were some way to identify the current RGB value automatically.

An Ugly Workaround

For charts with 6 or fewer entries, a simple workaround is to exploit the fact that theme colors are assigned sequentially, so I can do (e.g.)

chrt.SeriesCollection(1).DataLabels.Format.TextFrame2.TextRange.Font.Fill.ForeColor.ObjectThemeColor _ = msoThemeColorAccent1 

Presumably this could be extended to account for the TintAndShade used to differentiate entries once the theme has been exhausted, but this is such an ugly hack.

Research

Someone asked essentially the same question (how to extract theme colors) here, but it was never answered. There are several sources suggesting ways to convert a known theme color into RGB values (e.g. here and here) but that just begs the question; I don't know the color a priori, other than "whatever color this line currently is."

回答1:

So this is interesting. I create a line chart using all defaults, and then I run this procedure:

Sub getLineCOlors() Dim cht As Chart Dim srs As Series Dim colors As String Dim pt As Point  Set cht = ActiveSheet.ChartObjects(1).Chart  For Each srs In cht.SeriesCollection     With srs.Format.Line     colors = colors & vbCrLf & srs.Name & " : " & _             .ForeColor.RGB     End With  Next  Debug.Print "Line Colors", colors  End Sub 

The Immediate window then displays:

Line Colors    Series1 : 16777215 Series2 : 16777215 Series3 : 16777215 

But this is clearly not the case. It is obvious that they all are different colors. If, instead of .RGB I do .ObjectThemeColor, then I get all 0, which is equally and demonstrably false by observing the chart!

Line Colors    Series1 : 0 Series2 : 0 Series3 : 0 

Now here is where it gets interesting:

If, after having created the chart I change the series colors (or even leave them unchanged, by assigning to the same ThemeColors), then the function shows valid RGBs:

Line Colors    Series1 : 5066944 Series2 : 12419407 Series3 : 5880731 

It is as if Excel (and PowerPoint/etc.) are completely unable to recognize the automatically assigned colors, on Line Charts. Once you assign a color, then it may be able to read the color.

NOTE: Line charts are picky, because you don't have a .Fill, but rather a .Format.Line.ForeColor (and .BackColor) and IIRC there are some other quirks, too, like you can select an individual point and change it's fill color, and then that affects the visual appearance of the preceding line segment, etc...

Is this limited to line charts? Perhaps. My past experience says "probably", although I am not in a position to say that this is a bug, it certainly seems to be a bug.

If I run a similar procedure on a Column Chart -- again using only the default colors that are automatically assigned,

Sub getCOlumnColors()  Dim cht As Chart Dim srs As Series Dim colors As String Dim pt As Point  Set cht = ActiveSheet.ChartObjects(2).Chart  For Each srs In cht.SeriesCollection      With srs.Format.Fill     colors = colors & vbCrLf & srs.Name & " : " & _             .ForeColor.RGB     End With  Next  Debug.Print "Column Colors", colors  End Sub 

Then I get what appear to be valid RGB values:

Column Colors  Series1 : 12419407 Series2 : 5066944 Series3 : 5880731 

HOWEVER: It still doesn't recognize a valid ObjectThemeColor. If I change .RGB then this outputs:

Column Colors  Series1 : 0 Series2 : 0 Series3 : 0 

So based on these observations, there is certainly some inability to access the ObjectThemeColor and/or .RGB property of automatically-assigned color formats.

As Tim Williams confirms, this was a bug as far back as 2005 at least as it pertains to the RGB, and probably that bug carried over in to Excel 2007+ with the ObjectThemeColor, etc... It is not likely to be resolved any time soon then, so we need a hack solution :)

UPDATED SOLUTION

Combine the two methods above! Convert each series from line to xlColumnClustered, then query the color property from the .Fill, and then change the series chart type back to its original state. This may be more reliable than trying to exploit the sequential indexing (which will not be reliable at all if the users have re-ordered the series, e.g., such that "Series1" is at index 3, etc.)

Sub getLineColors() Dim cht As Chart Dim chtType As Long Dim srs As Series Dim colors As String  Set cht = ActiveSheet.ChartObjects(1).Chart  For Each srs In cht.SeriesCollection     chtType = srs.ChartType     'Temporarily turn this in to a column chart:     srs.ChartType = 51     colors = colors & vbCrLf & srs.Name & " : " & _             srs.Format.Fill.ForeColor.RGB     'reset the chart type to its original state:     srs.ChartType = chtType Next  Debug.Print "Line Colors", colors  End Sub 


回答2:

Here is the code I used in the end.

Sub ShowSeries() Dim mySrs As Series Dim myPts As Points Dim chtType As Long Dim colors As String  With ActiveSheet     For Each mySrs In ActiveChart.SeriesCollection         'Add label         Set myPts = mySrs.Points         myPts(myPts.Count).ApplyDataLabels ShowSeriesName:=True, ShowValue:=False          'Color text label same as line color          'if line has default color         If mySrs.Border.ColorIndex = -4105 Then             chtType = mySrs.ChartType             'Temporarily turn this in to a column chart:             mySrs.ChartType = 51             mySrs.DataLabels.Format.TextFrame2.TextRange.Font.Fill.ForeColor.RGB = _                 mySrs.Format.Fill.ForeColor.RGB             'reset the chart type to its original state:             mySrs.ChartType = chtType          'if line has a color manually changed by user         Else             mySrs.DataLabels.Font.ColorIndex = mySrs.Border.ColorIndex         End If     Next End With 

End Sub



回答3:

After half a day I managed to solve this issue:

       Sub ......()         Dim k as Integer        Dim colorOfLine as Long         ...............        .................         'Loop through each series        For k = 1 To ActiveChart.SeriesCollection.Count              With ActiveChart.FullSeriesCollection(k)                  .HasDataLabels = True                  'Put a fill on datalabels                 .DataLabels.Format.Fill.Solid                  'Get color of line of series                 colorOfLine = .Format.Line.ForeColor.RGB                  'Assign same color on Fill of datalabels of series                .DataLabels.Format.Fill.ForeColor.RGB = colorOfLine                 'white fonts in datalabels                .DataLabels.Format.TextFrame2.TextRange.Font.Fill.ForeColor.RGB = RGB(255, 255, 255)              End With          Next k         ..........         End Sub 


标签
易学教程内所有资源均来自网络或用户发布的内容,如有违反法律规定的内容欢迎反馈
该文章没有解决你所遇到的问题?点击提问,说说你的问题,让更多的人一起探讨吧!