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

Lun*_*tik 1 excel charts vba excel-vba

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

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

  1. 解析图表系列值字符串并提取数据范围
  2. 在表上查找存储有关范围和要使用的颜色的信息

最后,我使用选项2,因为它似乎更容易实现并且正确管理颜色,我可能必须将它们存储在方法1中,否则它的好处.

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

所以虽然我有一个这个工作正常的版本,我敢肯定必须有一个更优雅的方式来实现这一点.

有什么建议?

Rya*_*non 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
Run Code Online (Sandbox Code Playgroud)

/编辑

这可能比优雅更野蛮,但我认为它符合你的要求.它涉及您的第一个项目符号点以获取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
Run Code Online (Sandbox Code Playgroud)

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
Run Code Online (Sandbox Code Playgroud)