Sub Test() Dim c As New PatternCanvas c.Width = 2 c.Height = 2 c.Clear c.PSet (0, 0) c.PSet (1, 1) With ActiveLayer.CreateRectangle(0, 0, 3, 3) .Fill.ApplyPatternFill cdrTwoColorPattern .Fill.Pattern.Canvas = c End WithEnd Sub