hi i made this small macro with frame (with the help of MEK code) to shrink inside side and outside. this code helped but this is not exactly solving my problem.Actually i was trying to do is to make my selection shrink to inside side or outside till my guidelines. if that is possible please let me know
https://we.tl/t-8nbtfrVV2a
So, you would like to select some shapes and running the code to stretch selection exactly between four guide lines. Even if the selection size is bigger or smaller than the area between these 4 guide lines...
Is this understanding correct?
Please, test the next code. It will do what I assumed in my above comment.
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
Sub testGuideLines() Dim g As Shape, arrG, maxGuideNo As Long, arrGX(3), arrGY(3), iG As Long, shR As ShapeRange Dim kX As Long, kY As Long, lft As Double, rght As Double, tp As Double, bt As Double Dim arrLR(1), arrTB(1), x As Double, y As Double, w As Double, h As Double, ang As Double 'check if there are only 4 guide lines in layer "Guides" (some other guides copied on the page are admitted, to not be used): maxGuideNo = ActivePage.Layers("Guides").Shapes.FindShapes(Type:=cdrGuidelineShape).Count If maxGuideNo <> 4 Then MsgBox "It works only for 4 guide lines!", vbInformation, "Wrong number of guides...": Exit Sub ActiveDocument.ReferencePoint = cdrCenter 'set the reference to place the streched selection where it needs to be Set shR = ActiveSelectionRange If shR.Shapes.Count = 0 Then MsgBox "At least a shape must be selected...", vbInformation, "No selected shape(s)": Exit Sub shR.GetBoundingBox x, y, w, h 'get selection dimensions (x and y not used...) 'put guides coordinates in two separate arrays (for x and y): For Each g In ActivePage.Layers("Guides").Shapes.FindShapes(Type:=cdrGuidelineShape).Shapes If g.Guide.Angle = 90 Then arrLR(kX) = g.CenterX: kX = kX + 1 Else arrTB(kY) = g.CenterY: kY = kY + 1 End If Next 'set which are the left, right, top and bottom guides (their coordinates): If arrLR(0) < arrLR(1) Then lft = arrLR(0): rght = arrLR(1) Else: lft = arrLR(1): rght = arrLR(0) If arrTB(0) < arrTB(1) Then bt = arrTB(0): tp = arrTB(1) Else: bt = arrTB(1): tp = arrTB(0) 'stretch the selection according to the arithmetic between the selection and (virtual) rectangle between guides: shR.Stretch 1 + (rght - lft - w) / w, 1 + (tp - bt - h) / h, True 'now place/center selection exactly between the four guides shR.CenterX = (rght - lft) / 2 + lft: shR.CenterY = (tp - bt) / 2 + bt End Sub
If you need to also have other guide lines, I can adapt the code to deal with them in different modes. You can name the necessary guides as l, r, b, t and the code can be shorter, or, if all the other unnecessary guides are inside the page and the ones to be used are to the most exterior sides, I can also adapt the code to identify them...
what if we have more then 6 or 8 guides on the page and we want to do the action with only left side guide only?
I am afraid I do not understand what you mean...
The above code tries answering the question as I understood it. And it makes sense only for four such guide lines. If you are referring to the most left side vertical guide and selected shapes to be stretched up to it, keeping their right existing side, it can be done. But it looks that my understanding of the question was not on the asking one taste. So i am a little more circumspect in working on something which I do not understand why would this be a need...
Problem is similar. i am working on a book of approx. 236 Pages. Last minute my client decide to add some pictures on approx. 96 pages. Now i want to make some space by stretching its text. That's why i thought to try your code maybe this can help to save my time. But my need is to create space on Left side only.