自动设置图表系列颜色以按类别而非系列匹配源单元格颜色

时间:2014-04-07 22:42:23

标签: excel vba colors charts

我有一个VBA代码可以自动更改图表中的颜色,我在这个网站上找到了它:http://datapigtechnologies.com/blog/index.php/automatically-set-chart-series-colors-to-match-source-cell-colors/

代码发布在下面。我的问题是我需要将此代码应用于图表的水平类别而不是系列,因为我使用的是水平条形图,数据必须以这种方式排列。如何更改VBA以将自动颜色更改应用于类别?

Sub CellColorsToChart()
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 :(得分:0)

以下代码可以帮助您解决问题。它遍历点并将它们着色为单元格的背景颜色,如果存在则迭代多个系列。

Sub CellColorsToChart()
Dim oChart As ChartObject
Dim MySeries As Series
Dim FormulaSplit As Variant
Dim SourceRangeColor As Long
Dim seriesArray() As Variant
Dim pointIterator As Integer

For Each oChart In ActiveSheet.ChartObjects

    For Each MySeries In oChart.Chart.SeriesCollection

        seriesArray = MySeries.Values
        For pointIterator = 1 To UBound(seriesArray)
            FormulaSplit = Split(MySeries.Formula, ",")
            SourceRangeColor = Range(FormulaSplit(2)).Item(pointIterator).Interior.Color
            MySeries.Points(pointIterator).Interior.Color = SourceRangeColor
        Next pointIterator
    Next MySeries
Next oChart

End Sub