Выделить объекты, запустить макрос
Sub rff()
On Error Resume Next
Dim s As Shape
ActiveDocument.BeginCommandGroup "Rainbow fountain fill"
For Each s In ActiveSelection.Shapes
With s.Fill.ApplyFountainFill(CreateCMYKColor(100, 0, 0, 0), CreateCMYKColor(100, 0, 0, 0))
.Type =...