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