优雅的方式在Excel中突出显示图表数据系列

时间:2009-07-02 08:46:48

标签: excel vba excel-vba charts

我想在表格中概述图表数据范围源,就像点击图表数据系列时GUI将蓝色范围概述一样。用户可以选择各种图表视图,每个数据系列的范围突出显示颜色需要与图表中显示的颜色相匹配。

为了记录,以下是我考虑的方法:

  1. 解析图表系列值字符串并提取数据范围
  2. 在存储有关范围和要使用的颜色的信息的表上进行查找
  3. 最后我使用选项2,因为它似乎更容易实现并且正确管理颜色我可能必须将它们存储在方法1中,否则它的好处。

    Worksheet_Change事件调用高亮显示过程,对图表名称进行查找,从表格中提取范围和颜色,然后执行单元格格式化。此方法的局限性在于必须预先计算每个新图表视图的范围/颜色数据。对于我目前的实现来说,这不是一个大问题,但是我将成为未来使用中的限制因素,其中图表可能更具动态性。

    所以虽然我已经有了这个工作正常的版本,但我确信必须有更优雅的方法来实现这一目标。

    有什么建议吗?

2 个答案:

答案 0 :(得分:5)

编辑:

好的,这似乎可以更好地处理更多案件。触发代码是相同的,但这里是模块的新代码:

Function SeriesRange(s As Series) As Range
    Dim sf As String, fa() As String


    sf = s.Formula
    sf = Replace(sf, "=SERIES(", "")

    If sf = "" Then
        Set SeriesRange = Nothing
        Exit Function
    End If

    fa = Split(sf, ",")


    Set SeriesRange = Range(fa(2))

End Function

Sub x(c As Chart)
    Dim sc As Series
    Dim sr As Range

    If SeriesRange(c.SeriesCollection(1)) Is Nothing Then
        Exit Sub
    End If

    Set sr = SeriesRange(c.SeriesCollection(1))

    sr.CurrentRegion.Interior.ColorIndex = xlNone
    For Each sc In c.SeriesCollection
        If sc.Interior.Color > 1 Then
            SeriesRange(sc).Interior.Color = sc.Interior.Color
        ElseIf sc.Border.ColorIndex > 1 Then
            SeriesRange(sc).Interior.Color = sc.Border.Color
        ElseIf sc.MarkerBackgroundColorIndex > 1 And sc.MarkerBackgroundColorIndex < 57 Then
            SeriesRange(sc).Interior.ColorIndex = sc.MarkerBackgroundColorIndex
        ElseIf sc.MarkerForegroundColorIndex > 1 And sc.MarkerForegroundColorIndex < 57 Then
            SeriesRange(sc).Interior.ColorIndex = sc.MarkerForegroundColorIndex
        Else
            MsgBox "Unable to determine chart color for data series " & sc.Name & " ." & vbCrLf _
                    & "It may help to assign a color rather than allowing AutoColor to assign one."
        End If
    Next sc

End Sub

/编辑

这可能比优雅更野蛮,但我认为它符合你的要求。它涉及您的第一个项目符号点,以获取Series对象的范围,以及一个子项来运行图表Series中的所有SeriesCollection个对象。这是在Chart_DeActivate上激活的。这些代码的大部分内容都被提升了 - 请参阅有关来源的评论。

在一个模块中:

Function SeriesRange(s As Series) As Range
    Dim sf As String, fa() As String
    Dim i As Integer
    Dim result As Range

    sf = s.Formula
    sf = Replace(sf, "=SERIES(", "")

    fa = Split(sf, ",")

    Set SeriesRange = Range(fa(2))
End Function

Sub x(c As Chart)
    Dim sc As Series
    Dim sr As Range

    Set sr = SeriesRange(c.SeriesCollection(1))

    sr.CurrentRegion.Interior.ColorIndex = xlNone

    For Each sc In c.SeriesCollection
        SeriesRange(sc).Interior.Color = sc.Interior.Color
    Next sc

End Sub

ThisWorkbook对象模块中:

' Jacked from C Pearson http://www.cpearson.com/excel/Events.aspx '
Public WithEvents CHT As Chart

Private Sub CHT_Deactivate()
    x CHT 
End Sub

Private Sub Workbook_Open()
    Set CHT = Worksheets(1).ChartObjects(1).Chart 
End Sub

答案 1 :(得分:1)

您是否尝试过使用条件格式?