Sub Test() Dim s As Shape Dim pf As PatternFill Set s = ActiveLayer.CreateRectangle(0, 0, 4, 4) Set pf = s.Fill.ApplyPatternFill(cdrTwoColorPattern, , 8) pf.TileWidth = 1 pf.TileHeight = 1 pf.TileOffsetType = cdrTileOffsetRow pf.TileOffset = 50End Sub