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 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