Sub Test() Dim c As New PatternCanvas Dim n As Long c.Size = cdrPatternCanvas64x64 c.Clear For n = 2 To 63 Step 2 c.Line (0, 0)-(n, n), , B Next n With ActiveLayer.CreateRectangle(0, 0, 2, 2) .Fill.ApplyPatternFill cdrTwoColorPattern .Fill.Pattern.Canvas = c End WithEnd Sub