Please change code to vertically space apart shapes

Sub SpaceV()
    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 = cdrTopLeft
    addup = h
    
    For i = 1 To sr.Count
        If i > 1 Then
            sr(i).GetBoundingBox x1, y1, w1, h1
            sr(i).SetPosition x, y + h1 + addup
            addup = addup + h1 + space
        Else
            sr(i).Move -space, 0
        End If
    Next i
End Sub