View Single Post
Old 12-05-2010, 18:30
runflacruiser's Avatar
runflacruiser runflacruiser is offline
Senior Member
Join Date: Jun 2009
Location: Pigeon Forge, TN USA
Posts: 811

This will be useful for me too. I have had this in my mind for sometime as an addon for one of my macros.

Option Explicit

Sub fitEmIn()

Dim s As Shape
Dim sr As ShapeRange
Dim i As Integer
Dim x#, y#, w#, h#
Dim x1#, y1#, w1#, h1#
Dim addup As Double
Dim space As Double
Dim itemsCount As Long
Dim boxLen As Double
Dim shapesLen As Double
Dim entry As Variant

entry = InputBox("Enter box width", "Fit em in!", 35)
If entry = "" Then Exit Sub
boxLen = entry

Set sr = ActiveSelectionRange
sr(1).GetBoundingBox x, y, w, h

For Each s In sr
    shapesLen = shapesLen + s.SizeWidth
Next s

space = (boxLen - shapesLen) / sr.Count
space = space + (space / sr.Count)

ActiveDocument.ReferencePoint = cdrBottomRight

addup = w
For i = 1 To sr.Count
    If i > 1 Then
        sr(i).GetBoundingBox x1, y1, w1, h1
        sr(i).SetPosition x + w1 + addup, y
        addup = addup + w1 + space
        sr(i).Move -space, 0
    End If
Next i

End Sub

Reply With Quote