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
Thanking you
sir if any active selection is existed, then it is not removing the powerclip outline transparency. if no selection, then it is removing everything. please kindly correct when having selection, powerclip outline transparency also must be removed.
Sub RemoveTrans() Dim s As Shape, sC As Shape, p As Integer, srOut As shapeRange, srPC As shapeRange Dim OrigSelection As shapeRange Dim selectedShapes As shapeRange Optimization = True: EventsEnabled = False ActiveDocument.BeginCommandGroup "TrNO" Set OrigSelection = ActiveSelectionRange If OrigSelection.shapes.Count > 0 Then Set selectedShapes = OrigSelection Else Set selectedShapes = FindAllShapes() End If For Each s In selectedShapes If s.Transparency.Type > 0 Then s.Transparency.ApplyNoTransparency End If If Not s.PowerClip Is Nothing Then s.PowerClip.EnterEditMode Set srPC = s.PowerClip.shapes.All If srPC.Count > 0 Then For Each sC In srPC If sC.Transparency.Type > 0 Then sC.Transparency.ApplyNoTransparency End If Next sC End If s.PowerClip.LeaveEditMode End If Next s ActiveDocument.EndCommandGroup ActiveDocument.ClearSelection Optimization = False: EventsEnabled = True ActiveWindow.Refresh: Application.RefreshEnd Sub
Function FindAllShapes() As shapeRange Dim s As Shape, srPowerClipped As New shapeRange, sr As shapeRange, srAll As New shapeRange Set sr = ActivePage.shapes.FindShapes() 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 = srAllEnd Function
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