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

continuation of the topic


Myron say
Oh, forgot to mention there is more than 1 powerclip. Imagine a "boat load" of powerclips that have a boat load of shapes in them and they all have overprint fills. We want to remove the overprint from all those shapes within each powerclip.

p.s. back to this original post. Just like the overprint fills issue above. Set each transparent shape within multiple powerclips to Fill Only"

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
this fragment will be executed until all the power clips have been processed
 
Parents
  • Still not working. Errors at Set srOutlines = FindAllShapes.Shapes.FindShapes(Query:="@com.OverPrintOutline = 'True'")

    Sub RemoveOverprintFromPowerClip()
    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
    End Function

Reply Children