将图表系列颜色设置为匹配类别单元格颜色VBA

时间:2016-06-06 18:34:04

标签: excel excel-vba charts vba

我需要VBA宏来匹配我的类别背景颜色和折线图系列颜色。 现在我没有使用最佳方式,因为我正在应用以下代码 how code works

设置与源单元格颜色相同的图表系列颜色。 (图片上的例子)

但我希望这个宏能够从类别的单元格(2009,2010,2011代表性)中获取颜色而不是源单元格。

我找不到简单直接的方法。我为源单元格设置背景颜色以匹配类别颜色,然后我使用条件格式将白色放在源单元格的顶部。因此,只有类别是丰富多彩的,源细胞是白色的。 That's how it looks like at the end

想知道是否有更好的方法。 (pic上的最终结果,类别与系列颜色匹配的名称)

Dim oChart As ChartObject
Dim MySeries As Series
Dim FormulaSplit As Variant
Dim SourceRange As Range
Dim SourceRangeColor As Long

'Loop through all charts in the active sheet
For Each oChart In ActiveSheet.ChartObjects

    'Loop through all series in the target chart
   For Each MySeries In oChart.Chart.SeriesCollection

        'Get Source Data Range for the target series
       FormulaSplit = Split(MySeries.Formula, ",")

        'Capture the first cell in the source range then trap the color
       Set SourceRange = Range(FormulaSplit(2)).Item(1)
        SourceRangeColor = SourceRange.Interior.Color

        On Error Resume Next
        'Coloring for Excel 2003
       MySeries.Interior.Color = SourceRangeColor
        MySeries.Border.Color = SourceRangeColor
        MySeries.MarkerBackgroundColorIndex = SourceRangeColor
        MySeries.MarkerForegroundColorIndex = SourceRangeColor

        'Coloring for Excel 2007 and 2010
       MySeries.MarkerBackgroundColor = SourceRangeColor
        MySeries.MarkerForegroundColor = SourceRangeColor
        MySeries.Format.Line.ForeColor.RGB = SourceRangeColor
        MySeries.Format.Line.BackColor.RGB = SourceRangeColor
        MySeries.Format.Fill.ForeColor.RGB = SourceRangeColor

    Next MySeries
Next oChart

End Sub

1 个答案:

答案 0 :(得分:1)

假设我理解完全你在问什么,你就非常接近在那里。我认为你的代码中的问题是如何拆分系列公式以获得标签颜色。

我打开了这个图表,列标题是这样的:

enter image description here

使用以下代码进入下面的图表:

Sub SetColors()

Dim oChart As ChartObject
Dim MySeries As Series

For Each oChart In ActiveSheet.ChartObjects

    For Each MySeries In oChart.Chart.SeriesCollection

        Dim sFormula As String
        sFormula = Split(MySeries.Formula, ",")(0) 'this returns the =SERIES(Sheet!RC part of the formula, the first argument is the series label
        sFormula = Split(sFormula, "(")(1) 'this removes the =SERIES(  leaving only the column label range (Sheet!RC)

        Dim lSourceColor As Long
        lSourceColor = Range(sFormula).Interior.Color

        With MySeries
            .Interior.Color = lSourceColor
            .Border.Color = lSourceColor
            '.MarkerBackgroundColorIndex = lSourceColor
            '.MarkerForegroundColorIndex = lSourceColor
            .MarkerBackgroundColor = lSourceColor
            .MarkerForegroundColor = lSourceColor
            With .Format.Line
                .ForeColor.RGB = lSourceColor
                .BackColor.RGB = lSourceColor
            End With
            .Format.Fill.ForeColor.RGB = lSourceColor
        End With

    Next

Next

End Sub

enter image description here