How to or where to add code to existing macro to include shapes within all powerclips?

Sub RemoveAllOverPrints()
Dim s As Shape
Dim p As Page
Dim srOutlines As ShapeRange, srFills As ShapeRange

For Each p In ActiveDocument.Pages
p.Activate

Set srOutlines = p.Shapes.FindShapes(Query:="@com.OverPrintOutline = 'True'")
Set srFills = p.Shapes.FindShapes(Query:="@com.OverPrintFill = 'True'")

For Each s In srOutlines.Shapes
s.OverprintOutline = False
Next s

For Each s In srFills.Shapes
s.OverprintFill = False
Next s
Next p
End Sub

Parents
  • Myron, 

    Use my FindAllShapes Function

    Sub RemoveAllOverPrints()
        Dim s As Shape
        Dim p As Page
        Dim srOutlines As ShapeRange, srFills As ShapeRange
        
        For Each p In ActiveDocument.Pages
            p.Activate
            
            Set srOutlines = FindAllShapes.Shapes.FindShapes(Query:="@com.OverPrintOutline = 'True'")
            Set srFills = FindAllShapes.Shapes.FindShapes(Query:="@com.OverPrintFill = 'True'")
            
            For Each s In srOutlines.Shapes
                s.OverprintOutline = False
            Next s
            
            For Each s In srFills.Shapes
                s.OverprintFill = False
            Next s
        Next p
    End Sub
    
    Function FindAllShapes() As ShapeRange
        Dim s As Shape
        Dim srPowerClipped As New ShapeRange
        Dim sr As ShapeRange, srAll As New ShapeRange
        
        If ActiveSelection.Shapes.Count > 0 Then
            Set sr = ActiveSelection.Shapes.FindShapes()
        Else
            Set sr = ActivePage.Shapes.FindShapes()
        End If
        
        Do
            For Each s In sr.Shapes.FindShapes(Query:="!@com.powerclip.IsNull")
                srPowerClipped.AddRange s.PowerClip.Shapes.FindShapes()
            Next s
            
            srAll.AddRange sr
            sr.RemoveAll
            sr.AddRange srPowerClipped
            srPowerClipped.RemoveAll
        Loop Until sr.Count = 0
        
        Set FindAllShapes = srAll
    End Function
    


    -Shelby

Reply Children
No Data