Sub RemoveTransparencyFromOutlines2() For i = 1 To shapes.count With shapes(i) If .Outline.Transparency > 0 Then .Outline.Transparency = 0 End If End With Next iEnd Sub
This is not working, Please someone help
The outline in CoreDraw dont have a transparency parameter. End of macro.
but we have 2 options while using the transparency tool.... fill or outline or both
pkg_sriram said:powerclip outline transparency also must be removed.
Powerclip outline transparencycannot be set or deletedalways without transparency
set the power clip outline width to zero and draw an additional object with transparencysimulating the outline - if necessary
oho sorry sir. i had not explained clearly. powerclipped frame inner object's outline transparency also must be removed from this script sir. the script is removing everything including powerclipped frame inner outline transparency objects, but it is not removing if i have an active selection. please see the script sir
Sub RemoveTrans()Dim s As Shape, sC As Shape, p As Integer, srOut As shapeRange, srPC As shapeRangeDim OrigSelection As shapeRangeDim selectedShapes As shapeRangeOptimization = True: EventsEnabled = FalseActiveDocument.BeginCommandGroup "TrNO"Set OrigSelection = ActiveSelectionRangeIf OrigSelection.shapes.Count > 0 ThenSet selectedShapes = OrigSelectionElseSet selectedShapes = FindAllShapes()End IfFor Each s In selectedShapesIf s.Transparency.Type > 0 Thens.Transparency.ApplyNoTransparencyEnd IfIf Not s.PowerClip Is Nothing Thens.PowerClip.EnterEditModeSet srPC = s.PowerClip.shapes.AllIf srPC.Count > 0 ThenFor Each sC In srPCIf sC.Transparency.Type > 0 ThensC.Transparency.ApplyNoTransparencyEnd IfNext sCEnd Ifs.PowerClip.LeaveEditModeEnd IfNext sActiveDocument.EndCommandGroupActiveDocument.ClearSelectionOptimization = False: EventsEnabled = TrueActiveWindow.Refresh: Application.RefreshEnd Sub
Function FindAllShapes() As shapeRangeDim s As Shape, srPowerClipped As New shapeRange, sr As shapeRange, srAll As New shapeRangeSet sr = ActivePage.shapes.FindShapes()DoFor Each s In sr.shapes.FindShapes(Query:="!@com.powerclip.IsNull")srPowerClipped.AddRange s.PowerClip.shapes.FindShapes()Next ssrAll.AddRange srsr.RemoveAllsr.AddRange srPowerClippedsrPowerClipped.RemoveAllLoop Until sr.Count = 0Set FindAllShapes = srAllEnd Function
pkg_sriram said:please see the script sir
here correct variant
DelTransOut2.zip
sir it is removing the transparency all. but i want to restrict this to active selection only... if there is no active selection, then active page it removes all sir
pkg_sriram said:active selection only
it`s easy - no macro
Select - Transparency Tool - No Transparency