continuation of the topicMyron sayOh, 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
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 = 0End Function
before
after
what am I doing wrong?
can I see your document - where does the error appear?
overprint macro testing.zip
im test it - NO error