Sub Test() Dim s As Shape Dim pf As PatternFill Set s = ActiveLayer.CreateRectangle(0, 0, 2, 2) Set pf = s.Fill.ApplyPatternFill(cdrTwoColorPattern, , 6) pf.BackColor.RGBAssign 255, 0, 0End Sub