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

前端 未结 3 1857
抹茶落季
抹茶落季 2021-02-08 11:09

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

相关标签:
3条回答
  • 2021-02-08 11:45

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

    enter image description here

    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
    
    0 讨论(0)
  • 2021-02-08 12:03

    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

    0 讨论(0)
  • 2021-02-08 12:09

    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
    
    0 讨论(0)
提交回复
热议问题