Sub Test() Dim c As New color Dim s As Shape c.UserAssign For Each s In ActiveSelection.Shapes s.Fill.ApplyUniformFill c Next sEnd Sub