使用VBA替换PowerPoint图表主题色触发运行时错误13的求助

问题根因 #

运行时错误13（类型不匹配）由以下几个问题导致：

• 亮度参数oldTint/newTint被声明为String类型，但ForeColor.Brightness属性返回值为Single数值类型，二者直接对比会触发类型不匹配
• 代码开启了With oshp块但未补全End With语句，语法结构异常
• 未提前判断图表系列是否存在有效数据点，也没有校验填充类型，当系列无数据点、填充为非纯色填充时，访问相关属性会触发异常
• 变量声明不规范，部分变量隐式声明为Variant类型，进一步增加了类型不匹配的概率

修复方案 #

1. 调整参数类型：将亮度参数改为Single类型，适配Brightness的返回值类型
2. 补全语法结构：删除不必要的With块或者补全End With语句
3. 增加前置校验：遍历数据点前先判断Points.Count是否大于0，访问填充属性前先判断填充是否为纯色填充
4. 优化判断逻辑：亮度比较增加浮点误差容错，避免精度问题导致匹配失败
5. 补充系列级填充处理：未单独设置点填充时，颜色是绑定在系列上的，新增这部分逻辑避免漏改

修正后完整代码 #

Sub ReplaceColors(OldColor As MsoThemeColorIndex, NewColor As MsoThemeColorIndex, oldTint As Single, newTint As Single, chkTexts As Boolean, chkShapes As Boolean, optTargetSlides As Boolean, chkGrouped As Boolean)
    Dim i As Integer, t As Integer
    Dim osld As Slide
    Dim TargetSlides As SlideRange
    Dim oshp As Shape
    Dim oSeries As Object
    Dim oPoint As Object
    Dim x As Integer, y As Integer
    Dim sBrightness As Variant
    Dim oColor As ThemeColor, nColor As ThemeColor
    Dim oPP As Placeholders

    Set TargetSlides = ActivePresentation.Slides.Range
    For Each osld In TargetSlides
        For Each oshp In osld.Shapes
            If oshp.Type = msoChart Then
                For Each oSeries In oshp.Chart.SeriesCollection
                    ' 处理系列级填充
                    If oSeries.Format.Fill.Type = msoFillSolid Then
                        If oSeries.Format.Fill.ForeColor.ObjectThemeColor = OldColor And _
                        Abs(oSeries.Format.Fill.ForeColor.Brightness - oldTint) < 0.001 Then
                            oSeries.Format.Fill.ForeColor.ObjectThemeColor = NewColor
                            oSeries.Format.Fill.ForeColor.Brightness = newTint
                        End If
                    End If
                    ' 仅存在数据点时遍历
                    If oSeries.Points.Count > 0 Then
                        For Each oPoint In oSeries.Points
                            If oPoint.Format.Fill.Type = msoFillSolid Then
                                If oPoint.Format.Fill.ForeColor.ObjectThemeColor = OldColor And _
                                Abs(oPoint.Format.Fill.ForeColor.Brightness - oldTint) < 0.001 Then
                                    oPoint.Format.Fill.ForeColor.ObjectThemeColor = NewColor
                                    oPoint.Format.Fill.ForeColor.Brightness = newTint
                                End If
                            End If
                        Next
                    End If
                Next
            End If
        Next
    Next
End Sub

调用示例 #

如果需要将所有Accent1替换为Accent3，亮度均为0，调用参考：
Call ReplaceColors(msoThemeColorAccent1, msoThemeColorAccent3, 0, 0, False, False, True, False)

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