Sub Test() Dim crv As Curve, s As Shape Set crv = CreateCurve(ActiveDocument) For Each s In ActivePage.Shapes crv.AppendCurve s.DisplayCurve Next s Set s = ActiveLayer.CreateCurve(crv) s.Fill.UniformColor.RGBAssign 255, 0, 0End Sub