I need a macro to ungroup large amounts of groups within groups. This is what I have made so far. The problem I am running into is that I can't seem to get it to follow any logic to end the Do loop other then the counter down below but if I do to many step throughs then it errors out the macro. I can't seem to get myself to accept the error. How can I fix what I am doing wrong? Any help would be greatly appreciated.
Sub UngroupItall()
Dim GroupedShapes As ShapeDim SelectedArea As ShapeRangeDim Variable01 As VariantSet SelectedArea = ActiveSelectionRange
For Each GroupedShapes In SelectedArea Do Until Variable01 = 100 If GroupedShapes.Type = cdrGroupShape Then ab = ab + 1 GroupedShapes.UngroupAll End If Loop Next GroupedShapes
End Sub
Why would you want a macro to do it. Ctrl+A to select all and then 'Ungroup all'.
Any ways I can try to write a macro for you but you will have to allow me a day as I have not installed DRAW on my home machine.
No that works very well. It wasn't something I saw in my shortcut csv file because it didn't have a shorcut to it. Ctrl+A is Select all for me. Thank you for letting me know about the command. You have saved me a lot of time.
Try this code.
Dim doc As DocumentDim sr As ShapeRangeDim shp As ShapeDim pg As Page
Private Sub UnGroupAll()If CorelDRAW.Documents.Count > 0 ThenSet doc = CorelDRAW.ActiveDocumentFor Each pg In doc.Pages Set sr = pg.SelectableShapes.All For Each shp In sr If shp.Type = cdrGroupShape Then shp.UnGroupAll End If NextNextMsgBox "Ungroup All performed."EndElseMsgBox "No document found open"EndEnd If
Anand Dixit said:Try this code.
Hi Anand.
Nice... I Hope you don't mind my input.
Also try this. It does the job without activating the pages and uses CQL instead so you don't have to loop through the shapes. It should run very fast.
Sub ungroupItemsOnAllPages() Dim p As Page Dim j As Long For j = 1 To ActiveDocument.Pages.count ActiveDocument.Pages(j).Shapes.FindShapes(Query:="@type = 'group'").UngroupAll Next j End Sub
-John
Hi,
thanks for the code, it works 100% on files with with about 10x pages, problem is i have 1000x a3 pages per file with 8x pieces of text per page. now, all of the information is grouped and i need to ungroup all of it as the layout is changing.
the problem is that i have a total of 30000x codes to insert and move.
Please could you assist me in this regard?
Hi.
Did you try both of the above codes?
~John
I actually did yes, the top one gave me an error code, not sure why though??
HI.
It's hard to debug without a test fle. What is the error you are getting?
i've just tried to take 2x pieces of the text and have them duplicate 210mm to the left using the following code:
ActiveDocument.CreateSelection ActiveLayer.Shapes(2), ActiveLayer.Shapes(1)Dim dup1 As ShapeRangeSet dup1 = ActiveSelection.DuplicateAsRange()dup1.Move -8.267717, 0#ActiveDocument.CreateSelection ActiveDocument.Pages(2).Layers("Layer 1").Shapes(2)ActiveDocument.AddToSelection ActiveDocument.Pages(2).Layers("Layer 1").Shapes(1)Dim dup2 As ShapeRangeSet dup2 = ActiveSelection.DuplicateAsRange()dup2.Move -8.267717, 0#
i copied the code for 31 pages (updating the necessary page references in each instance) although the first page works fine, the second page skips and from then on the du[plication is effected on the pages although without moving the 210mm as required (so it duplicates itself over itself).
the ungroup does a similar thing whereby the first page ungroups perfectly although the rest stays grouped. when i manually ungroup these items i have to ungrounp up to 5 times before they are completely ungrouped, alternatively i click on ungroup all and then all is ungrouped on that page...
any ideas??
impalaart@telkomsa.net said:any ideas??
Looks like we'll have to deep clean these pages...lol
I'll get back to you with some code later but I never worked with 3000 pages before.
I gotta go for now.
I tested this with 4 pages and a few shapes. Seems to work good. Try it.
Sub unGroupAll() Dim p As Page, s As Shape, sr As ShapeRange Dim i& bFound = False For i = 1 To ActiveDocument.Pages.count ActiveDocument.Pages(i).Activate Set sr = ActiveDocument.Pages(i).Shapes.FindShapes(Query:="@type = 'group'") If sr.count > 0 Then For Each s In sr s.Ungroup Next s End If Next iEnd Sub