any easy fast possible way to group all these business cards separately. https://we.tl/tylZcTY3p6
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29
Sub group_on_selected_rectangles() Dim srRectangles As ShapeRange Dim sRect As Shape On Error GoTo ErrHandler ActiveDocument.BeginCommandGroup "Group objects on selected rectangles" EventsEnabled = False Optimization = True Set srRectangles = ActiveSelectionRange For Each sRect In srRectangles ActivePage.SelectShapesFromRectangle sRect.LeftX, sRect.BottomY, sRect.RightX, sRect.TopY, False ActiveSelectionRange.Group Next sRect ExitSub: Optimization = False EventsEnabled = True ActiveDocument.EndCommandGroup Refresh Exit Sub ErrHandler: MsgBox "Error occurred: " & Err.Description Resume ExitSub End Sub
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
Some of the PowerClip frames are Curves, not Rectangles.
If I select one of those and try to resize it, it does something like this:
VIDEO:crazy curve.
exactly this was that issue sir any solution for this?
The next code (an adaptation of Shelby code plus my sequence of transforming powerclip Cuves in PowerClip Rectangle) does whatever the initial code used to do plus conversion you need it:
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53
Sub group_on_selected_rectangles_And_Curve_Repair() Dim srSelection As ShapeRange, srRectangles As ShapeRange Dim sRect As Shape, sShapes As ShapeRange, pCl As PowerClip Dim sRect1 As Shape, pClSh As ShapeRange 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 On Error Resume Next Set pCl = sRect.PowerClip On Error GoTo 0 If Not pCl Is Nothing Then If pCl.Parent.Type = cdrCurveShape Then Set pClSh = pCl.Shapes.All pCl.ExtractShapes Set sRect1 = ActiveLayer.CreateRectangleRect(pCl.Parent.BoundingBox) sRect1.Outline.Color = pCl.Parent.Outline.Color pCl.Parent.Delete pClSh.AddToPowerClip sRect1 ActivePage.SelectShapesFromRectangle sRect1.LeftX, sRect1.BottomY, sRect1.RightX, sRect1.TopY, False ActiveSelectionRange.Group Else ActivePage.SelectShapesFromRectangle sRect.LeftX, sRect.BottomY, sRect.RightX, sRect.TopY, False ActiveSelectionRange.Group End If Else ActivePage.SelectShapesFromRectangle sRect.LeftX, sRect.BottomY, sRect.RightX, sRect.TopY, False ActiveSelectionRange.Group End If Next sRect ExitSub: ActiveDocument.ClearSelection Optimization = False EventsEnabled = True ActiveDocument.EndCommandGroup Refresh Exit Sub ErrHandler: MsgBox "Error occurred: " & Err.Description Resume ExitSub End Sub
You will obtain groups but all powerClip inside them will be rectangles and you can play with their dimensions.
But Eskimo asked about the reason of this dimensions modification and you didn't say anything. At least I did nos see such an answer... So, why?
Besides his logic question I also have two other:
1. Doesn't you bother the rectangle outline color? Can you cut exactly on the edge?
2. Don't you need the bottom yellow rectangle to be outside the powerclip, in order to cut in color?
FaneDuru said:Don't you need the bottom yellow rectangle to be outside the powerclip, in order to cut in color?
That's what I meant by, "bleed".
I know what bleed means...
Theoretically that bleed exists but hidden inside the powerclip. And I tried to clearly suggest to think about that yellow (almost...) rectangle on the bottom, even if this can be used only on the lateral sides. It should be extended down...
I do not imagine how modifying the dimensions will solve the missing bleed...
FaneDuru said:I know what bleed means...
I didn't state that you didn't know what bleed means. I was pointing out that when I wrote, "bleed", I was thinking of the same sort of problem that you described later for the yellow rectangle.
FaneDuru said:I do not imagine how modifying the dimensions will solve the missing bleed...
Note my comment earlier about the possibility of replacing the original PowerClip frames with larger rectangles.
If the problem is bleed, however, larger PowerClip frames still would not provide additional "yellow area" on the bottom edges of the cards. The PowerClip is only clipping them on the left and right sides. So, if bleed is needed on the bottom edge, then the "yellow rectangles" would need to be resized.
I would guess that this could all be solved very nicely if the problem were defined well enough.