jessew1987
New Member
Hey Guys, I just made this macro for myself and thought maybe someone on here could use it. Basically it takes your selected object and makes the page size a bit larger than your object and centers the object to the page. It makes the page size larger based on percentage, not a static measurement so you always have a good amount of space. Because I use multiple pages, I don't like working off the page. Obviously signs are usually much larger than letter size paper, so if you're constantly resizing the page to fit your large sign, than this might be for you.
Sub pgsz()
Dim W As Double
Dim H As Double
Dim W2 As Double
Dim H2 As Double
Dim OB As Shape
Set OB = ActiveShape
If OB Is Nothing Then
MsgBox "Please Select an object", vbExclamation, "Error"
End
End If
W = ActiveSelection.SizeWidth / 2.5
H = ActiveSelection.SizeHeight / 2.5
W2 = ActiveSelection.SizeWidth + ((W + H) / 2)
H2 = ActiveSelection.SizeHeight + ((W + H) / 2)
ActivePage.SetSize W2#, H2#
If ActiveSelection.Shapes.Count = 1 Then
ActiveSelection.AlignToPage cdrAlignHCenter, cdrTextAlignBoundingBox
ActiveSelection.AlignToPage cdrAlignVCenter, cdrTextAlignBoundingBox
Else
ActiveSelection.Group
ActiveSelection.AlignToPage cdrAlignHCenter, cdrTextAlignBoundingBox
ActiveSelection.AlignToPage cdrAlignVCenter, cdrTextAlignBoundingBox
ActiveSelection.Ungroup
End If
End Sub
Sub pgsz()
Dim W As Double
Dim H As Double
Dim W2 As Double
Dim H2 As Double
Dim OB As Shape
Set OB = ActiveShape
If OB Is Nothing Then
MsgBox "Please Select an object", vbExclamation, "Error"
End
End If
W = ActiveSelection.SizeWidth / 2.5
H = ActiveSelection.SizeHeight / 2.5
W2 = ActiveSelection.SizeWidth + ((W + H) / 2)
H2 = ActiveSelection.SizeHeight + ((W + H) / 2)
ActivePage.SetSize W2#, H2#
If ActiveSelection.Shapes.Count = 1 Then
ActiveSelection.AlignToPage cdrAlignHCenter, cdrTextAlignBoundingBox
ActiveSelection.AlignToPage cdrAlignVCenter, cdrTextAlignBoundingBox
Else
ActiveSelection.Group
ActiveSelection.AlignToPage cdrAlignHCenter, cdrTextAlignBoundingBox
ActiveSelection.AlignToPage cdrAlignVCenter, cdrTextAlignBoundingBox
ActiveSelection.Ungroup
End If
End Sub