Sub Test() Dim c As PatternCanvas Set c = CreatePatternCanvas c.PutCopy PatternCanvases(29) With ActiveLayer.CreateRectangle(0, 0, 2, 2) .Fill.ApplyPatternFill cdrTwoColorPattern .Fill.Pattern.Canvas = c c.Data = "%%['$aH,&A5&0C" End WithEnd Sub