Sub Test() Dim s As Shape Set s = ActiveLayer.CreateRectangle(1, 1, 3, 3) s.Transparency.ApplyUniformTransparency (10) Set s = ActiveLayer.CreatePolygon(1, 4, 5, 6, 6) s.Transparency.ApplyTextureTransparency "Above the storm" For Each s In ActivePage.Shapes If s.Transparency.Type = cdrTextureTransparency Then s.Transparency.MergeMode = cdrMergeBlue End If Next sEnd Sub