Sub Test1() Dim s As Shape, eff As Effect Dim sr As New ShapeRange For Each s In ActivePage.Shapes For Each eff In s.Effects If eff.Type = cdrLens Then If eff.Lens.Type = cdrLensTransparency Then sr.Add s Exit For End If Next eff Next s sr.CreateSelection End Sub