PowerPoint VBA为图片添加PictureEffects效果生效不一致问题求助

核心错误点 #

• 你当前调用的shp.Fill.PictureEffects是面向「填充内容为图片的形状/占位符」的接口，直接插入的原生图片对象（即msoPicture类型的Shape）的效果属性位于shp.PictureFormat.PictureEffects下，两类对象的接口不通用，遍历的时候判断错类型就会直接抛出异常中断运行。
• 未在添加效果前清空已有效果，重复插入相同效果会触发PowerPoint 2013的已知COM对象引用bug，导致运行几个对象后自动终止。
• 未做类型校验就直接调用图片相关属性，遇到文本框、图形等非图片元素时会直接报错。

修复后完整代码 #

Sub 批量为所有图片添加锐化效果()
    Dim sld As Slide
    Dim shp As Shape
    Dim eff As PictureEffect
    
    ' 遍历所有幻灯片
    For Each sld In ActivePresentation.Slides
        ' 遍历当前幻灯片所有元素
        For Each shp In sld.Shapes
            ' 只处理两类图片：原生插入的图片、填充为图片的形状/占位符
            If shp.Type = msoPicture Or (shp.Fill.Type = msoFillPicture) Then
                ' 先清空已有图片效果，避免冲突
                If shp.Type = msoPicture Then
                    shp.PictureFormat.PictureEffects.Delete
                    ' 插入锐化效果
                    Set eff = shp.PictureFormat.PictureEffects.Insert(msoEffectSharpenSoften)
                Else
                    shp.Fill.PictureEffects.Delete
                    ' 插入锐化效果
                    Set eff = shp.Fill.PictureEffects.Insert(msoEffectSharpenSoften)
                End If
                ' 设置锐化强度，1对应100%锐化
                eff.EffectParameters(1).Value = 1
                ' 手动释放COM对象，避免2013版本的内存泄漏bug
                Set eff = Nothing
            End If
        Next shp
    Next sld
End Sub

适配PowerPoint 2013的补充说明 #

• 你遇到的运行几张后失效的问题属于Office 2013的已知bug，上述代码中每次操作后手动释放eff对象可以解决90%以上的意外中断问题
• 如果仍偶发报错，可在Next shp前加一行DoEvents主动让出CPU时间片，让PowerPoint完成效果渲染后再处理下一个对象
• PNG、JPG格式本身不影响识别，只要类型判断正确所有常规图片格式都可正常处理

内容的提问来源于stack exchange，提问作者Sephiroth Cloud Delacroix