VBA:用默认颜色提取图表中线条的RGB值
问题
我想知道如何读取图表中自动分配的颜色的当前RGB值，即使这需要将颜色冻结到当前值(而不是随着主题的改变而更新，序列被重新排序等等)。
Usecase
我的实际使用是，我想要使数据标记匹配线/标记的颜色在一个线图。如果我已经通过一个方案或显式的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，用于在主题耗尽后区分条目，但这是一个非常糟糕的攻击。
研究
有人提出了本质上相同的问题(如何提取主题颜色) 这里，但它从未得到回答。有几个来源建议如何将已知的主题颜色转换为RGB值(例如这里和这里)，但这只是一个问题；除了“这行当前的任何颜色”之外，我不知道该颜色是什么颜色。
回答 3
Stack Overflow用户
发布于 2014-09-13 18:40:50
所以这很有趣。我使用所有缺省值创建一个线条图，然后运行以下过程：
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 -还有一些其他的怪癖，比如你可以选择一个单独的点并改变它的填充颜色，然后这会影响前面的线段的视觉外观，等等……
，这是否仅限于线条图?也许是。我过去的经验说“可能”，虽然我不能说这是一个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但是:它仍然不识别有效的ObjectThemeColor。如果我更改了.RGB，则输出如下：
Column Colors
Series1 : 0
Series2 : 0
Series3 : 0因此，基于这些观察结果，当然无法访问自动分配的颜色格式的ObjectThemeColor和/或.RGB属性。
正如Tim所证实的那样，这是一个早在2005年就存在的bug --至少与RGB有关，而且很可能是该bug与ObjectThemeColor一起遗留到Excel ObjectThemeColor中，等等……它不太可能很快解决，所以我们需要一个黑客解决方案:)
更新解决方案
将以上两种方法结合起来！将每个系列从一行转换为xlColumnClustered，然后从.Fill查询颜色属性，然后将序列图表类型更改为原始状态。这可能比尝试利用顺序索引更可靠(如果用户重新订购了该系列，例如，"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 SubStack Overflow用户
发布于 2016-10-03 14:28:21
下面是我最后使用的代码。
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结束子对象
Stack Overflow用户
发布于 2016-07-21 15:34:42
半天之后，我设法解决了这个问题：
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 Subhttps://stackoverflow.com/questions/25825269
复制相似问题
腾讯云开发者
