Sub Test() Dim c As New PatternCanvas Dim x As Long, y As Long c.PutCopy PatternCanvases(8) For x = 0 To c.Width - 1 For y = 0 To c.Height - 1 c.Pixel(x, y) = Not c.Pixel(x, y) Next y Next x With ActiveLayer.CreateRectangle(0, 0, 3, 3) .Fill.ApplyPatternFill cdrTwoColorPattern, , 8 End With With ActiveLayer.CreateRectangle(3, 0, 6, 3) .Fill.ApplyPatternFill cdrTwoColorPattern .Fill.Pattern.Canvas = c End WithEnd Sub