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

我想知道如何读取图表中自动指定颜色的当前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个或更少条目的图表，一个简单的解决方法是利用主题颜色是按顺序分配的这一事实，这样我就可以做到（例如）

假设这可以扩展到

TintAndShade

，用于在主题用尽后区分条目，但这是一个非常丑陋的黑客行为

研究

---

有人问了本质上相同的问题（如何提取主题颜色），但没有人回答。有几个来源建议将已知主题颜色转换为RGB值（例如和），但这只是回避了问题；除了“这条线现在是什么颜色”之外，我不知道它是什么颜色。所以这很有趣。我使用所有默认值创建折线图，然后运行以下过程：

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

现在这里是有趣的地方：

如果在创建图表后，我更改了系列颜色（甚至通过指定相同的颜色使其保持不变），则函数将显示有效的RGB：

Line Colors   
Series1 : 5066944
Series2 : 12419407
Series3 : 5880731

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

注意：折线图很挑剔，因为你没有

.Fill

，而是

.Format.Line.ForeColor

（和

.BackColor

）和IIRC还有一些其他的怪癖，比如你可以选择一个点并改变它的填充颜色，然后影响前面线段的视觉外观等

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

如果我在柱状图上运行类似的过程——同样只使用自动指定的默认颜色

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

但是：它仍然无法识别有效的

对象ThemeColor

。如果我更改

.RGB

，则输出：

Column Colors 
Series1 : 0
Series2 : 0
Series3 : 0

因此，根据这些观察结果，肯定无法访问自动指定颜色格式的

对象ThemeColor

和/或

.RGB

属性

正如Tim Williams所证实的，这是一个早在2005年就存在的bug，至少与RGB有关，而且可能是该bug通过对象ThemeColor等带入Excel 2007+。。。这不太可能很快得到解决，因此我们需要一个黑客解决方案：）

更新的解决方案

结合以上两种方法！将每个系列从line转换为

xlColumnClustered

，然后从

.Fill

查询颜色属性，然后将系列图表类型更改回其原始状态。这可能比尝试利用顺序索引更可靠（如果用户重新排序了序列，例如“Series1”位于索引3等，则顺序索引根本不可靠）

---

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

       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

---

这是我最后使用的代码

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

---

这是一个很好的第一个问题。我似乎还记得，像这样处理折线图特别困难，在PPT中处理图表上的主题颜色（和一些非主题颜色）时也遇到过类似的问题。我将查看是否有一个函数可以帮助您…尝试调试，即使我分配

srs.Format.Line.ForeColor.ObjectThemeColor=msoThemeColorAccent2

，然后尝试查询

？srs.Format.Line.ForeColor.ObjectThemeColor

给我

0

（应该是6）。无论使用什么颜色，我都得到零。看看这里的答案是否能帮助你：@DavidZemens谢谢你的建议（以及友好的反馈！）。事实上，我在我的问题结束时联系到了这个答案；问题是，我不知道尝试提取哪种主题颜色（或其变体）——除了利用我的知识，即它在6种调色板颜色中循环使用亮度变化的颜色，这是我宁愿避免的。对。这就好像他们故意让ThemeColors难以使用一样。我看到了一个有趣的观察结果，我将把它作为一个“答案”添加进来，因为它太大了，无法放入评论中。如果珀尔蒂埃和沃肯巴赫这么说，那肯定是个bug。很难相信它能持续十年

       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

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