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
That's it. That's what I was looking for.
I was trying using the "SendKeys" with a shortcut I had assigned but it was only working for one at a time.
Now, the "Application.FrameWork.Automation.Invoke" and then the GUID is what I was talking about in the beggining of this post, when I wrote:
"How about if we perform a mouse click on that item??Is this even possible?"
I had already seen this in a post in this forum, but can't find it.I believe that I must explore this "Invoke".
EDIT:
It works if the PowerClip doen't have anything, If it does, it extract the contents.I have modified the "s.PowerClip.ExtractShapes" to "s.PowerClip.Shapes.All.Delete"
THANK YOU VERY MUCH.I appreciate all the help from you all.
I think I found a nice workaround behaving well for all kind of shapes. It is not necessary to select anything. The code itself will work only on the PowerClip shapes.
Please try this:
1 2 3 4 5 6 7 8 9
Sub TestPowerClBoundary() Dim shS As ShapeRange, pClSh As Shape, shBound As Shape, No As Long For Each pClSh In ActivePage.Shapes.All.Shapes.FindShapes(Query:="!@com.powerclip.IsNull") Set shS = pClSh.PowerClip.Shapes.FindShapes() ' powerClip shapes shS.Delete Set shBound = pClSh.PowerClip.Parent.CreateBoundary(pClSh.CenterX, pClSh.CenterY, True, True) shBound.name = "Boundary " & No: No = No + 1 Next End Sub
I just introduced 'No' in order to see how you can trigger the new created shape and do whatever you need with it...
Some of us thrashed around on this a bit a few months ago in this thread: powerclip none - give it global - feature request - reg.
If I want to keep the shape that was originally the PowerClip frame, but don't want to keep any of the contents, then I didn't find it necessary to extract / delete. Using "Unassign Frame" seems to take care of that automatically.
Sub Unassign_PowerClip_frames() Dim sr As ShapeRange Dim s As Shape On Error GoTo ErrHandler Set sr = ActiveSelectionRange For Each s In sr If Not s.PowerClip Is Nothing Then s.CreateSelection Application.FrameWork.Automation.InvokeItem "7b022531-3cd7-487f-a797-9d80179dc821" DoEvents End If Next s ExitSub: Refresh Exit Sub ErrHandler: MsgBox "Error occurred: " & Err.Description & vbCrLf & vbCrLf & "Unassign_PowerClip_frames()" Resume ExitSub End Sub