根据单元格值更改图表颜色

Question

我有一个包含2个数据系列的图表，这些图表使用条件格式引用单元格值来确定其颜色。我在网上查找了VBA代码，以便在图表上根据单元格颜色更新该系列的颜色，但是运行该代码时什么也没发生。

有人可以帮我吗？

Sub CellColorsToChart()
'Updateby Extendoffice
Dim xChart As Chart
Dim I As Long, J As Long
Dim xRowsOrCols As Long, xSCount As Long
Dim xRg As Range, xCell As Range
On Error Resume Next
Set xChart = ActiveSheet.ChartObjects("Chart 2").Chart
If xChart Is Nothing Then Exit Sub
xSCount = xChart.SeriesCollection.Count
For I = 1 To xSCount
    J = 1
    With xChart.SeriesCollection(I)
        Set xRg = ActiveSheet.Range(Split(Split(.Formula, ",")(2), "!")(1))
        If xSCount > 4 Then
        xRowsOrCols = xRg.Columns.Count
        Else
        xRowsOrCols = xRg.Rows.Count
        End If
        For Each xCell In xRg
            .Points(J).Format.Fill.ForeColor.RGB = ThisWorkbook.Colors(xCell.Interior.ColorIndex)
            .Points(J).Format.Line.ForeColor.RGB = ThisWorkbook.Colors(xCell.Interior.ColorIndex)
            J = J + 1
        Next
    End With
Next
End Sub

Answer 1

xCell.Interior引用单元格应用的颜色，而不是条件格式。

如果您使用的是Excel 2010+，则应使用.DisplayFormat来获取条件格式的颜色。

另外，为什么还要打扰ThisWorkbook.Colors和ColorIndex，只需引用颜色即可：

.Points(J).Format.Fill.ForeColor.RGB = xCell.DisplayFormat.Interior.Color

此外，在设置On Error Resume Next来捕获Set xChart =上的错误之后，您必须重置错误处理

On Error Resume Next
    Set xChart = ActiveSheet.ChartObjects("Chart 2").Chart
On Error GoTo 0 ' <~~ reset error handling
If xChart Is Nothing Then Exit Sub