Sub Test() Dim s As Shape For Each s In ActivePage.Shapes If s.Transparency.Type = cdrUniformTransparency Then s.Transparency.Uniform = 50 End If Next sEnd Sub