PowerPoint: Resizing Height and Width of selected shapes

'**************************************************************
' Setting the size (Width x Height) of selected shapes with user
' input
' For this macro to work properly, you need to select one or
' more shapes.
' The macro asks for user input to enter Width and Height
' By default, the Input box displays maximum height and width
' of all the selected shapes
'**************************************************************
Sub Resize_Selected_Shapes()

Dim shp As Shape
Dim BoxWidth, BoxHeight As Integer

If ActiveWindow.Selection.Type = ppSelectionNone Then
MsgBox "Please select objects to resize", vbExclamation, "Make Selection"
Else
' 1st Pass - get the desired width & height
For Each shp In ActiveWindow.Selection.ShapeRange
If shp.Width > MaxWidth Then MaxWidth = shp.Width
If shp.Height > MaxHeight Then MaxHeight = shp.Height
Next shp

'Get the desired box dimensions - set default as max width & max height
BoxWidth = InputBox("Enter the required Width " & Chr(10) & _
"(Default is Largest Width of selected boxes)", "Box Width", MaxWidth)
BoxHeight = InputBox("Enter the required Height " & Chr(10) & _
"(Default is Largest Width of selected boxes)", "Box Height", MaxHeight)

' 2nd pass - change the sizes
For Each shp In ActiveWindow.Selection.ShapeRange
shp.LockAspectRatio = msoFalse
shp.Width = BoxWidth
shp.Height = BoxHeight
Next shp
End If

End Sub