Sub Test() Dim idx As Long, i As Long Dim doc As Document Dim p As Page Dim s As Shape Set doc = ActiveDocument idx = doc.ActivePage.Index For i = idx To doc.Pages.Count Set p = doc.Pages(i) Set s = p.ActiveLayer.CreateRectangle(0, 0, p.SizeWidth, 0.5) s.Fill.UniformColor.CMYKAssign 0, 0, 0, 100 Next iEnd Sub