VBA：使用默认颜色提取图表中线条的 RGB 值

Posted 2023-02-23

【中文标题】VBA：使用默认颜色提取图表中线条的 RGB 值

【英文标题】：VBA: Extracting the RGB value of lines in a chart with default colors

【发布时间】：2014-11-07 15:14:40

【问题描述】：

问题

我想知道如何读取图表中自动分配颜色的当前 RGB 值，即使这需要将颜色冻结为其当前值（而不是在更改主题时更新它们，重新排序系列，等等）

用例

我的实际用例是我想让数据标签与折线图中线条/标记的颜色相匹配。如果我通过方案或显式 RGB 值明确设置系列的颜色，这很容易，例如

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

但是，在自动分配系列颜色时执行此操作会产生白色标签。更具体地说，以下两个等式都成立

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

然而，这条线当然不是白色的，而是主题自动分配的颜色。这表明颜色是自动分配的

s.Border.ColorIndex = xlColorIndexAutomatic

我认为颜色没有与相关系列一起存储是有道理的。即使将索引存储到配色方案中通常也不起作用，因为如果添加了另一个数据系列或有人重新排序数据，Excel 需要更改颜色。不过，如果有某种方法可以自动识别当前的 RGB 值，我会很高兴的。

一个丑陋的解决方法

对于包含 6 个或更少条目的图表，一个简单的解决方法是利用主题颜色按顺序分配的事实，因此我可以这样做（例如）

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

据推测，这可以扩展为在主题耗尽后用于区分条目的 TintAndShade，但这是一个丑陋的 hack。

研究

有人问了基本相同的问题（如何提取主题颜色）here，但从未得到回答。有几个来源建议将已知主题颜色转换为 RGB 值的方法（例如 here 和 here），但这只是引出了问题；我不知道颜色先验，除了“这条线当前是什么颜色”。

【问题讨论】：

这是一个很好的第一个问题。我似乎记得 line 图表特别难以像这样使用，在 PPT 中的图表上使用主题颜色（和一些非主题颜色）时遇到了一些类似的问题。我看看有没有什么功能可以帮到你……

尝试调试，即使我 assign srs.Format.Line.ForeColor.ObjectThemeColor = msoThemeColorAccent2 然后尝试查询 ?srs.Format.Line.ForeColor.ObjectThemeColor 给我 0（应该是 6）。无论使用什么颜色，我都会得到零。

看看这里的答案能不能帮到你：***.com/questions/21142732/…

@DavidZemens 感谢您的建议（以及友好的反馈！）。实际上，我在问题的最后链接到了那个答案；问题是我不知道要尝试提取哪种主题颜色（或其变体）——没有利用我的知识，即它在 6 种调色板颜色之间循环，亮度变化，我宁愿避免这种情况。

对。就好像他们故意让 ThemeColors 难以使用。我看到一个有趣的观察结果，我将其添加为“答案”，因为它太大而无法放入 cmets。

【参考方案1】：

所以这很有趣。我使用所有默认值创建折线图，然后运行此过程：

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

随即显示立即窗口：

Line Colors   
Series1 : 16777215
Series2 : 16777215
Series3 : 16777215

但显然情况并非如此。很明显，它们都是不同的颜色。如果不是.RGB，而是.ObjectThemeColor，那么我得到所有0，通过观察图表，这同样明显是错误的！

Line Colors   
Series1 : 0
Series2 : 0
Series3 : 0

这里是有趣的地方：

如果在创建图表后我更改系列颜色（或者甚至通过分配相同的 ThemeColors 使它们保持不变），则该函数显示有效的 RGB：

Line Colors   
Series1 : 5066944
Series2 : 12419407
Series3 : 5880731

就好像 Excel（和 PowerPoint/等）完全无法识别折线图上的自动分配颜色。一旦你指定了颜色，它就可以读取颜色。

注意：折线图很挑剔，因为您没有.Fill，而是.Format.Line.ForeColor（和.BackColor）和IIRC 还有一些其他怪癖，就像你可以选择一个单独的 point 并改变它的填充颜色，然后这会影响前面线段的视觉外观等......

这仅限于折线图吗？也许。我过去的经验说“可能”，虽然我不能说这是一个错误，但它确实似乎是一个错误。

如果我在柱形图上运行类似的程序——再次仅使用自动分配的默认颜色，

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

然后我得到似乎是有效的 RGB 值：

Column Colors 
Series1 : 12419407
Series2 : 5066944
Series3 : 5880731

但是：它仍然无法识别有效的ObjectThemeColor。如果我更改.RGB，则输出：

Column Colors 
Series1 : 0
Series2 : 0
Series3 : 0

因此，根据这些观察结果，肯定无法访问 自动分配颜色格式的 ObjectThemeColor 和/或 .RGB 属性。

正如 Tim Williams 所证实的，这是一个早在 2005 年就存在的错误，至少与 RGB 相关，并且可能该错误通过 ObjectThemeColor 等延续到 Excel 2007+ 中......不太可能很快就会得到解决，所以我们需要一个黑客解决方案:)

更新的解决方案

结合以上两种方法！将每个系列从 line 转换为 xlColumnClustered，然后从 .Fill 查询 color 属性，然后将系列图表类型更改回其原始状态。这可能比尝试利用顺序索引更可靠（如果用户重新排序了系列，则根本不可靠，例如，“Series1”位于索引 3 等）

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

【讨论】：

近十年前：类似问题 - office-archive.com/33-excel/57ab74e17cab9710.htm

谢谢蒂姆。如果 Peltier 和 Walkenbach 这么说，那么这绝对是一个错误。很难相信它会持续十年或更长时间！

这是一个绝妙的解决方案。当我实现这个时，图表类型变为模板，右侧的第二个垂直轴仍然存在。这可以通过在最后将图表类型（对于整个图表）更改回 Line 来解决。

很好的答案！我必须修改它以查看条形图中的每个点，因为条形是按值进行颜色编码的。不幸的是，它们设置了主题，我无法找出颜色来制作匹配的图例。现在我已经有了它们，我将使用本练习中的 RGB 值来设置所有内容。

【参考方案2】：

半天后，我设法解决了这个问题：

       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

【参考方案3】：

这是我最后使用的代码。

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

结束子