hi there. I have this code to search for a remove the lens effects for objects on a page but I want it to dig into groups but I'm not sure how to do this? Any help is appreciated.
Private Sub CommandButton1_Click() Dim s As Shape For Each s In ActivePage.Shapes If s.Transparency.Type <> cdrNoTransparency Then s.Transparency.ApplyNoTransparency End If Next sEnd Sub
I tried this but I'm still missing something.
Sub ApplyNoTransparency() Dim sr As ShapeRange Set sr = ActivePage.FindShapes(Type:=cdrNoTransparency = 1) If sr.Count <> 0 Then sr.Transparency.ApplyNoTransparency Else MsgBox "There are no lens objects on the current page" End IfEnd Sub
There will probably be groups, and groups within groups. This needs a recursive function call.
Code will look something like this
Private Sub RecurseObj(ss As Shapes)Dim s As ShapeFor Each s In ss If s.Type = cdrGroupShape Then ' If this is a group shape, then all the shapes in this group ' are processed by calling the function recursively. RecurseObj s.Shapes ' Recursive call Else
'Your code here End IfNext sEnd Sub
Shape can have two types of transparency — the usual and the lens effect. Decide what transparency you want to remove
Here is a macro that removes both types of transparency:
Sub ClearTransp()Dim sr As ShapeRange, s As Shape
Set sr = ActivePage.FindShapes() sr.ClearEffect cdrLens For Each s In sr If s.Transparency.Type <> cdrNoTransparency Then s.Transparency.ApplyNoTransparency NextEnd Sub
Thank you very much Shark and Suku. I will try these out and let you know how it goes.