Need help placing objects below one another.
Here's how the current macro is placing the objects on page 1.
So for each object on each page, move to page 1, below text 1, repeat and place below text 2, etc...
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 '______________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
Here's one way to do it:
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
Thank you that worked!Is there a way to select the texts from top to bottom and combine them so they stay in order?