如何关闭PPT文档所有形状（含组及子组）的渐变填充？遍历遇阻

你当前的代码仅能处理幻灯片顶层的独立形状，无法遍历组内的子形状，因此需要通过递归的方式逐层处理所有嵌套的形状。

以下是修正后的完整代码：

Sub RemoveAllGradientFills()
    Dim targetSlide As Slide
    ' 指定要处理的幻灯片，示例为当前演示文稿的第1张
    Set targetSlide = ActivePresentation.Slides(1)
    
    ' 遍历幻灯片上的所有顶层形状
    Dim shp As Shape
    For Each shp In targetSlide.Shapes
        ProcessShape shp
    Next shp
End Sub

' 递归处理单个形状（含组内子形状）
Private Sub ProcessShape(ByVal shp As Shape)
    ' 如果是组形状，遍历组内的每个子形状并递归处理
    If shp.Type = msoGroup Then
        Dim groupItem As Shape
        For Each groupItem In shp.GroupItems
            ProcessShape groupItem
        Next groupItem
    Else
        ' 非组形状，设置为纯色填充以移除渐变
        shp.Fill.Solid
    End If
End Sub

代码说明： #

• RemoveAllGradientFills 是主过程，指定目标幻灯片后，调用递归函数处理每个顶层形状。
• ProcessShape 是递归子过程：
  • 先判断当前形状是否为组（msoGroup），如果是则遍历组内所有子形状，再次调用自身深入处理。
  • 如果不是组形状，直接执行 shp.Fill.Solid 移除渐变填充。

如果需要处理演示文稿中所有幻灯片的形状，可以使用以下主过程（保留上面的ProcessShape子过程即可）：

Sub RemoveAllGradientFillsInAllSlides()
    Dim targetSlide As Slide
    For Each targetSlide In ActivePresentation.Slides
        Dim shp As Shape
        For Each shp In targetSlide.Shapes
            ProcessShape shp
        Next shp
    Next targetSlide
End Sub

内容的提问来源于stack exchange，提问作者Miguel de las Nieves