Sub Test() 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 = cdrExtrude Then With eff.Extrude If .AngleX <> 0 Or .AngleY <> 0 Or .AngleZ <> 0 Then sr.Add s End With Exit For End If Next eff Next s sr.CreateSelection End Sub