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
Parents
  • You might be able to modify this?

    [CODE]

    Public Sub FindTrans()

    Dim sr As ShapeRange, s As Shape, eff As Effect
    Dim i&
    Dim sr2 As New ShapeRange

    For i = 1 To ActiveDocument.Pages.count
    Set sr = ActiveDocument.Pages(i).Shapes.All
    For Each s In sr

    If s.Transparency.Type = cdrUniformTransparency Then _
    MsgBox "Found "
    For Each eff In s.Effects
    If eff.Lens.Type = cdrLensTransparency Then
    eff.Clear 'clears effects
    sr2.Add s 'add to the 2nd shaperange to allow selection at the end
    End If

    Next eff

    Next s
    Next i

    sr2.CreateSelection

    [/CODE]

Reply Children
No Data