Sub Test() Dim c As New PatternCanvas c.PutCopy PatternCanvases(25) c.RotateArea 0, 0, c.Width - 1, c.Height - 1, 180 With ActiveLayer.CreateRectangle(0, 0, 3, 3) .Fill.ApplyPatternFill cdrTwoColorPattern .Fill.Pattern.Canvas = c End WithEnd Sub