Sub Test() Dim c As New PatternCanvas c.Size = cdrPatternCanvas32x32 c.FillArea 0, 0, 31, 31, True c.FillArea 0, 0, 18, 18, False c.FillArea 14, 14, 31, 31, False c.FillArea 14, 14, 18, 18, True With ActiveLayer.CreateRectangle(0, 0, 2, 2) .Fill.ApplyPatternFill cdrTwoColorPattern .Fill.Pattern.Canvas = c End WithEnd Sub