如何用VBA实现仅为Excel图表中存在的指定名称系列设置颜色

原代码失效的核心问题 #

• 系列名匹配逻辑错误：你使用LCase$()将系列名转换为全小写后，和首字母大写的"Erneuerbare"做匹配，二者永远无法命中，因此颜色设置逻辑从未执行
• 冗余的对象激活操作：频繁调用Activate、ActiveChart不仅拖慢执行速度，还容易出现对象引用异常
• 缺少异常兼容：未判断图表是否存在坐标轴就直接设置坐标轴标题，遇到无坐标轴的图表会触发运行时错误
• 变量未声明：nSrs、iSrs未提前定义，容易触发隐式声明的异常

修正后可直接运行的代码 #

Sub LoopThroughCharts()
    Dim sht As Worksheet
    Dim CurrentSheet As Worksheet
    Dim cht As ChartObject
    Dim ch As Chart
    Dim nSrs As Long, iSrs As Long
    
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    Set CurrentSheet = ActiveSheet
    
    For Each sht In ActiveWorkbook.Worksheets
        For Each cht In sht.ChartObjects
            ' 直接引用图表对象，无需激活
            Set ch = cht.Chart
            
            ' 通用图表格式设置
            With ch
                .ChartArea.Font.Name = "Flexo"
                .ChartArea.Font.Color = RGB(0, 0, 0)
                .PlotArea.Interior.Color = RGB(227, 228, 234)
                .ChartArea.Interior.Color = RGB(227, 228, 234)
                .PlotArea.Format.Line.ForeColor.RGB = RGB(255, 255, 255)
                
                ' 先判断是否存在分类轴再设置标题
                If .HasAxis(xlCategory) Then
                    .Axes(xlCategory).HasTitle = True
                    .Axes(xlCategory).AxisTitle.Font.Bold = True
                End If
                ' 先判断是否存在数值轴再设置标题
                If .HasAxis(xlValue) Then
                    .Axes(xlValue).HasTitle = True
                    .Axes(xlValue).AxisTitle.Font.Bold = True
                End If
                
                ' 系列颜色设置逻辑
                nSrs = .SeriesCollection.Count
                For iSrs = 1 To nSrs
                    ' 全小写匹配，避免大小写差异导致匹配失败
                    Select Case LCase$(.SeriesCollection(iSrs).Name)
                        Case "erneuerbare" ' 全小写和转换后的系列名匹配
                            ' 兼容柱形/条形等填充类图表
                            .SeriesCollection(iSrs).Interior.Color = RGB(136, 187, 60)
                            ' 兼容折线/散点等线条类图表，不需要可以删除
                            .SeriesCollection(iSrs).Border.Color = RGB(136, 187, 60)
                            .SeriesCollection(iSrs).MarkerForegroundColor = RGB(136, 187, 60)
                            .SeriesCollection(iSrs).MarkerBackgroundColor = RGB(136, 187, 60)
                    End Select
                Next iSrs
            End With
        Next cht
    Next sht
    
    CurrentSheet.Activate
    Application.EnableEvents = True
    Application.ScreenUpdating = True
End Sub

扩展说明 #

如果需要添加更多指定名称的系列颜色规则，只需要在Select Case块中新增Case "小写系列名"的分支，补充对应颜色设置即可。

内容的提问来源于stack exchange，提问作者Thomas Kouroughli