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
can I see your document - where does the error appear?
Oh no ... just try this5282.DelTransOut.zip
Crashes hard. Have to restart corel.
crash on a specific document? Can I look at it?
I renamed it. Only 1 pc w/transparent shape inside
Crashes at this line
yes - I agree - editing transparency directly in the power clip leads to a crash
Guess we're SOL then? lol
It’s too early to laugh - there’s still the good old “back door” - EnterEditModemost likely it won’t be so fast - but it will work - just need to think about the powerclip in the powerclip...
and yes - the power clip itself - can also have transparencyso - the fill is processed, but the outline is not
Hmmm, if I step through this with F8 it works perfect. Thoughts
Sub TransOutlineOff()Dim s As Shape, p As Integer, srOutlines As ShapeRange, ob As Integer ob = 0 For p = 1 To ActiveDocument.Pages.Count ActiveDocument.Pages(p).Activate Set srOutlines = FindAllShapes.Shapes.FindShapes(Query:="@com.transparency.type > 0") For Each s In srOutlines.Shapes s.Transparency.AppliedTo = cdrApplyToFill Next s ob = ob + srOutlines.Count srOutlines.RemoveAll Next p' MsgBox "Delete " & ob & " transparency"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 = srAllFor Each s In srAlls.AddToSelectionNext sActiveSelection.Transparency.AppliedTo = cdrApplyToFill
End Function
Uh....wait a minute, the code I pasted up there removes the transparencies altogether. grrr.
Thought I was onto something.