Align center and top inside object.

I would like some help with this macro.

Sub add_top()

Dim s As Shape
Dim s_info As Shape
Dim sr As ShapeRange

ActiveDocument.Unit = cdrCentimeter

Set sr = ActiveSelectionRange
If sr.Count = 0 Then Exit Sub

For Each s In sr.Shapes
Set s_info = ActiveLayer.CreateRectangle(s.LeftX, s.TopY, s.RightX, s.BottomY)
s_info.SizeHeight = 7
s_info.SizeWidth = 5
s_info.TopY = s.TopY
s_info.CenterX = s.CenterX
Next s

End Sub