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

时间:2014-09-13 16:32:06

标签: vba excel-vba colors excel

问题

我想知道如何读取图表中自动指定颜色的当前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,但这是一个如此丑陋的黑客。

研究

有人问了基本相同的问题(如何提取主题颜色)here,但从未回答过。有几个来源建议将已知主题颜色转换为RGB值的方法(例如herehere),但这只是问题;我不知道先验的颜色,除了“这条线目前的颜色是什么。”

3 个答案:

答案 0 :(得分:8)

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

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

然后显示立即窗口:

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还有一些其他的怪癖,就像你可以选择一个单独的并改变它的填充颜色,然后这会影响前一个线段的视觉外观等...... / p>

这仅限于折线图吗?也许吧。我过去的经历说"可能"虽然我不能说这是一个错误,但它肯定是一个错误。

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

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属性。

正如蒂姆·威廉姆斯所证实的那样,早在2005年这是一个错误,至少与RGB有关,可能是这个错误随着ObjectThemeColor转移到了Excel 2007+等......它不太可能随时解决,所以我们需要一个黑客解决方案:)

更新的解决方案

结合上述两种方法!将每个系列从行转换为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 Sub

答案 1 :(得分:2)

这是我最后使用的代码。

 UPDATE `tickets`
 INNER JOIN 
(SELECT tm.ticket_ID, MAX(`date`) as d 
  FROM `ticket_messages` as tm
  GROUP BY tm.ticket_ID
  HAVING d < date_sub(curdate(), interval 5 day)) AS T
 ON T.ticket_ID = `tickets`.ticket_ID
 SET`status`=?

End Sub

答案 2 :(得分:0)

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

       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