Please change code to vertically space apart shapes

Sub space()

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

space = 0

Set sr = ActiveSelectionRange

sr(1).GetBoundingBox x, y, w, h

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