Macro placement of objects

Try this

Sub pagesToLayers()
Dim s As Shape, sr As ShapeRange
Dim p As Page, i&, l As Layer

For i = 1 To ActiveDocument.Pages.Count
ActiveDocument.Pages(i).Activate
Set sr = ActivePage.Shapes.All
If sr.Count > 0 Then


'______________modifying_______________
Dim X As Double, Y As Double, Interv As Double
For Each s In sr
Interv = s.SizeHeight / 10
s.SetPosition X, Y - Interv
X = s.LeftX
Y = s.BottomY
Next s

'______________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

End If
Next i
End Sub


Regards

Taras