Sub Test() Dim s As Shape For Each s In ActivePage.Shapes s.Fill.ApplyUniformFill s.Layer.Color Next s End Sub