Search code examples
vbapowerpoint

Turn-off gradient fill in all shapes in PowerPoint document (including groups and sub groups)


I'm trying to turn off gradient fill in all shapes in a PowerPoint document (including groups and sub groups).

The thing is I can't even get to cycle through the shapes correctly

Sub solid()

Set myDocument = ActivePresentation.Slides(1)
For Each sh In myDocument.Shapes
    sh.Fill.solid
Next

End Sub

Thanks for your help.


Solution

  • Sub solid()
        Dim mydocument As Presentation
        Set mydocument = ActivePresentation
        Dim sh As Shape
        Dim sl As Slide
        For Each sl In mydocument.Slides
            For Each sh In sl.Shapes
                If HasGradient(sh) = True Then
                    sh.Fill.solid
                End If
            Next
        Next
    End Sub
    

    And also implement this function from TheSpreadSheetGuru to check whether the shape has a gradient value.

    Function HasGradient(shp As Shape) As Boolean
        'PURPOSE: Determine if a shape object contains a gradient format property
        'SOURCE: www.TheSpreadsheetGuru.com/the-code-vault
        
        Dim GradientStopCount As Long
        
        'Test for Gradient Stops
          On Error Resume Next
          GradientStopCount = shp.Fill.GradientStops.Count
          On Error GoTo 0
        
        'Results
          If GradientStopCount <> 0 Then
            HasGradient = True
          Else
            HasGradient = False
          End If
    
    End Function