Sub Test() Dim s As Shape For Each s In ActivePage.Shapes If s.Fill.Type = cdrUniformFill Then s.Fill.UniformColor.LabAssign 128, 0, 0 End If Next s MsgBox s.Fill.UniformColor.LabComponentAEnd Sub