Macro placement of objects

Sub pagesToLayers()
    Dim s As Shape, sr As ShapeRange
    Dim p As Page, i&, l As Layer
    Dim dblPrevBottomY As Double
    Const dblVertGapTop As Double = 0.15
    Const dblVertGapBetween As Double = 0.3
   
    For i = 1 To ActiveDocument.Pages.Count
        ActiveDocument.Pages(i).Activate
        Set sr = ActivePage.Shapes.All
        If sr.Count > 0 Then
       
        '______________optional size shaperange_______________
        'sr.SetSize , ActivePage.SizeHeight 'set only height
        'sr.SetSize ActivePage.SizeWidth 'set only width
       
        '________optional center the shaperange to pg ________
        'sr.SetPositionEx cdrCenter, ActivePage.SizeWidth / 2, ActivePage.SizeHeight / 2
       
            ActiveDocument.Pages(1).Activate
            If ActivePage.Layers.Find("Layer_" & i) Is Nothing Then
                Set l = ActivePage.CreateLayer("Layer_" & i)
            Else
                Set l = ActivePage.Layers("Layer_" & i)
            End If
            sr.MoveToLayer l
            
            'center in X
            sr.CenterX = ActivePage.SizeWidth / 2
            
            If i = 1 Then
                'first sr on page; reference to page top
                sr.TopY = ActivePage.TopY - dblVertGapTop
            Else
                'reference to most-recently-placed sr
                sr.TopY = dblPrevBottomY - dblVertGapBetween
            End If
            
            dblPrevBottomY = sr.BottomY

        End If
    Next i
End Sub

Sub combine_text_sort_by_TopY()
Dim sr As ShapeRange
Dim s As Shape

    Set sr = ActiveSelectionRange
    sr.Sort "@shape1.com.TopY < @shape2.com.TopY"
    For Each s In sr
        s.Text.ConvertToParagraph
    Next s
    sr.Combine
End Sub