Hello.
I'm trying to create a macro that reverts all the selected shapes from PowerClip to normal shapes but without success.
My question is: Where is the PowerClip - Frame - No Frame in the VBA. I can't find it.
And no, if you have more than one PowerClip selected you can't access this menu item.
Because I usually do this for many shapes at once it would be greate to have.
My current code is:
Sub RevertPowerClipToShape() ActiveDocument.ReferencePoint = cdrCenter Dim OrigSelection As ShapeRange Set OrigSelection = ActiveSelectionRange Dim s As Shape If ActiveSelectionRange.Count = 0 Then MsgBox "No shapes selected" Exit Sub Else For Each s In OrigSelection s.PowerClip.Shapes.All.Delete Next s End IfEnd Sub
This removes the objects inside the powerclip but I still have the Frame on the shape.
Any help would be appreciated.
Best regards.
How about if we perform a mouse click on that item??Is this even possible?
I do not understand what you mean by 'perform a mouse click'? To do that programmatically according to some parameters?
But beside that the next example of code does not work for you?
You should select the POWERCLIP SHAPE!
Dim S as Shape
Set S = Active Shape
S.PowerClip.ExtractShapes
S.PowerClip.Parent.Delete
FaneDuru said:S.PowerClip.Parent.Delete
is equivalent of s.Delete, cause .Parent is pointing to the same object s
Yes, but the purpose of that small example was to understand what he needs and what his 'OrigSelection' means. I started to suppose that in fact he is selecting shapes of the Powerclip in edit mode and because of that your proposition doesn't work. If I am right his 's' is not a PowerClip shape...
Thank you very much for the help.
Explaining better:
1. Select more then one PowerClip (let's imagine that they are 2 rectangles with something inside, of cource)
2. Do the same as if we select only one PowerClip and Right Mouse Click and "Frame Type" and then "None"
But with a macro, so I can do it with a selection of several PowerClips
By the way, doing "s.PowerClip.ExtractShapes" gives me this error "Object doesn't support this property or method".But doing "s.PowerClip.Shapes.All.Delete" doesn't give error and deletes all the shapes inside the PowerClip, now the missing part is the "Frame Type" that has to be set to "None" by code.
Thank you.
I never did that by code and I am not sure it is possible, but I think you can try the next workaround, in case all your powerClip shapes are rectangles:
dim Rect as shape
'Whatever your code did here...
For Each s In OrigSelection 's.PowerClip.Shapes.All.Delete
set Rect = ActiveLayer.CreateRectangleRect(s.BoundingBox)
s.delete Next s
I mean you will create a rectangle on top of the existing empty powerclip and delete the former one... Is that convenient? Do you have other powerclip shapes than rectangles?
And you can use this code line to have all powerClips of the active layer in a ShapeRange:
Dim AllPCl as ShapeRange
set AllPCl = ActiveLayer.Shapes.All.Shapes.FindShapes(Query:="!@com.powerclip.IsNull")
I was thinking of the same thing.
The problem is that not always my shape are simetrical.
But, thank you very much for helping.
How about this one?
Sub ExtractAllPowerclipUltra() 'Extract shapes from powerclips and set frames to none Dim sr As ShapeRange, s As Shape Optimization = True ActiveDocument.BeginCommandGroup "ExtractAllPowerclipUltra" Set sr = ActiveSelectionRange For Each s In ActiveSelection.Shapes s.PowerClip.ExtractShapes s.RemoveFromSelection sr.AddToSelection If Not s.PowerClip Is Nothing Then If s.PowerClip.Shapes.Count = 0 Then s.CreateSelection Application.FrameWork.Automation.Invoke "7b022531-3cd7-487f-a797-9d80179dc821" End If End If DoEvents Next s Application.Optimization = False ActiveWindow.Refresh ActiveDocument.EndCommandGroupEnd Sub