need to use a macro to search for and list lens (transparency) objects...

Hi.  I'm trying to make a macro that will search a document and list all instances of transparency objects in each page.

Ive started with this code but I'm sure it's missing some things.

 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
Private Sub CommandButton1_Click()
Optimization = True
ActiveDocument.BeginCommandGroup
Dim sr As ShapeRange, s As Shape

Set sr = ActivePage.FindShapes()
    If sr.count = 0 Then
        MsgBox "No Lens objects found."
        Exit Sub
    End If
For Each s In sr
    If s.Transparency.Type <> cdrNoTransparency Then s.Transparency.ApplyNoTransparency
Next
ActiveDocument.EndCommandGroup
Optimization = False
End Sub