Sub Test() Dim spath As SubPath Dim s As Shape, sExt As Shape Dim i As Long Set s = ActiveShape If s.Curve.Subpaths.Count < 2 Then Exit Sub For i = s.Curve.Subpaths.Count To 1 Step -1 Set spath = s.Curve.Subpaths(i) Set sExt = spath.Extract(s) sExt.Outline.Width = 0.01 sExt.Outline.Color = ActivePalette.Color(13 + i) Next i End Sub