Sub ClearEffects_ActiveSelection2() If ActiveSelectionRange Is Nothing Then Exit Sub
Dim Shape As Shape Dim Shapes As ShapeRange Dim i As Long
Set Shapes = ActiveSelectionRange.Shapes.FindShapes(Query:="@com.Effects.Count > 0")
For Each Shape In Shapes For i = 1 To Shape.Effects.Count Shape.Effects(i).Clear Next i
Shape.CustomCommand "BlockShadow", "ClearBlockShadow" NextEnd Sub