Sub Test() Dim c As New PatternCanvas Dim x As Long, y As Long c.Size = cdrPatternCanvas64x64 c.Clear For x = 0 To c.Width - 1 For y = 0 To c.Height - 1 c.Pixel(x, y) = (((x + y) \ 2) Mod 2) <> 0 Next y Next x With ActiveLayer.CreateRectangle(0, 0, 2, 2) .Fill.ApplyPatternFill cdrTwoColorPattern .Fill.Pattern.Canvas = c End WithEnd Sub