Sub Test() Dim sr As ShapeRange Set sr = ActivePage.FindShapes(Type:=cdrTextShape) sr.ApplyPatternFill cdrTwoColorPattern, , 4, CreateRGBColor(255, 0, 0) sr.SetOutlineProperties 0.05End Sub