Pages from Shapes Macro

I have a macro i am working on that with take the shapes from a range and create pages from those shapes. I would like to get them to center to their respective pages but i seem to be stuck. Any help is appreciated. Thanks

Sub PageasShape()

Dim s As Shape, sr As ShapeRange
Dim w As Double, h As Double

Set sr = ActiveSelectionRange
If sr.Shapes.Count = 0 Then
MsgBox "Please make a selection"
Exit Sub
End If

For Each s In sr
ActiveDocument.AddPages (1)


s.GetSize w, h

ActivePage.SizeHeight = Round(h + 1, Precision)
ActivePage.SizeWidth = Round(w + 1, Precision)
ActiveDocument.ReferencePoint = srCenter

Next s

ActiveDocument.Pages(1).Activate

End Sub