any easy fast possible way to group all these business cards separately. https://we.tl/tylZcTY3p6
thanks eskimo i have done this project where i have to spend alot of time to group themi have around 468 different business cards my client send me design this way to printit save a lot of time for methankseven i can see that it work on almost every type of shapes like rectangle, sqaue, circle etcdont know how but thats even make this code more cool and useful
This will only work correctly if the shapes you are selecting are rectangular in shape, and are not rotated.
thats really awesum eskimo.. i need that regular box only.. thankssssss
Eskimo,
I hope you do not mind, I have changed your code a little bit. I added some CQL to find all other shapes the same size as the original one selected.
Happy Coding,
-Shelby
Sub group_on_selected_rectangles() Dim srSelection As ShapeRange, srRectangles As ShapeRange Dim sRect As Shape Set srSelection = ActiveSelectionRange If srSelection.Shapes.Count > 1 Then MsgBox "Please only select one shape.": Exit Sub On Error GoTo ErrHandler ActiveDocument.BeginCommandGroup "Group objects on selected rectangles" EventsEnabled = False Optimization = True Set srRectangles = ActivePage.Shapes.FindShapes(Query:="@width = {" & srSelection(1).SizeWidth & " in } and @height ={" & srSelection(1).SizeHeight & " in }") For Each sRect In srRectangles ActivePage.SelectShapesFromRectangle sRect.LeftX, sRect.BottomY, sRect.RightX, sRect.TopY, False ActiveSelectionRange.Group Next sRect ExitSub: ActiveDocument.ClearSelection Optimization = False EventsEnabled = True ActiveDocument.EndCommandGroup Refresh Exit Sub ErrHandler: MsgBox "Error occurred: " & Err.Description Resume ExitSub End Sub
No offense taken, Shelby!
I considered doing that, but came down on the side of "expose them to the benefits of Select Same" instead.
Seeing both ways? Even better.