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.TransformWithShape = True Set s = s.Duplicate(4, 0) s.StretchEx 2, , 4, 0End Sub