我有一个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
答案 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