Sub SetPageSameAsSelected()
Dim sr As ShapeRange, s As Shape
Dim x#, y#, w#, h#
ActiveDocument.BeginCommandGroup ("pagesize")
ActiveDocument.Unit = cdrMillimeter
Set sr = ActiveSelectionRange
If sr.Count = 0 Then Exit Sub
sr.GetBoundingBox x, y, w, h
ActivePage.SetSize w + 5, h + 5
sr.AlignRangeToPageCenter (cdrAlignVCenter)
ActiveDocument.EndCommandGroup
End Sub