Sub PrePressColorCalibrationBar() Dim doc As Document Dim s As Shape Set doc = CreateDocument Set s = ActiveLayer.CreateRectangle(0.667008, 10.302205, 2.906378, 8.062835, 0, 0, 0, 0) s.Fill.UniformColor.CMYKAssign 100, 0, 0, 0 s.Outline.Type = cdrNoOutline Set s = ActiveLayer.CreateRectangle(4.77252, 10.351969, 6.987008, 8.13748, 0, 0, 0, 0) s.Fill.UniformColor.CMYKAssign 0, 100, 0, 0 s.Outline.Type = cdrNoOutline Set s = ActiveLayer.CreateRectangle(0.990472, 6.569921, 3.105433, 4.454961, 0, 0, 0, 0) s.Fill.UniformColor.CMYKAssign 0, 0, 100, 0 s.Outline.Type = cdrNoOutline Set s = ActiveLayer.CreateRectangle(4.872047, 6.81874, 7.01189, 4.678898, 0, 0, 0, 0) s.Fill.UniformColor.CMYKAssign 0, 0, 0, 100 s.Outline.Type = cdrNoOutline With doc With .PrintSettings .Options.MarksToPage = True .Prepress.ColorCalibrationBar = True End With .PrintOut End WithEnd Sub