Sub Test() Dim s1 As Shape, s2 As Shape, s3 As Shape Set s1 = ActiveLayer.CreateRectangle(2.5, 8.5, 4.5, 6.5) s1.Fill.UniformColor.CMYKAssign 0, 100, 100, 0 Set s2 = s1.Duplicate s2.Fill.UniformColor.CMYKAssign 100, 0, 0, 0 ActiveDocument.ReferencePoint = cdrTopLeft s2.Stretch 0.866025, 1 s2.Skew 0, -30 s2.Move -0.866025, 0.5 Set s3 = s1.Duplicate s3.Fill.UniformColor.CMYKAssign 0, 0, 100, 0 s3.Stretch 0.866025, 1 s3.Skew 0, 30 s3.Move 0.866025, -0.5 s1.Stretch 0.866025, 1 s1.Skew 0, 30 s1.Rotate -60 s1.Move 0, 1End Sub