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
You might be able to modify this?
[CODE]
Public Sub FindTrans()
Dim sr As ShapeRange, s As Shape, eff As EffectDim 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 sNext i
sr2.CreateSelection
[/CODE]
For me cdrLensTransparency did not work...
Sub ClearLens()
Dim sr As ShapeRange, s As Shape, eff As Effect, i&
ActiveDocument.BeginCommandGroup "Clear lens"
For i = 1 To ActiveDocument.Pages.CountSet sr = ActiveDocument.Pages(i).Shapes.All
For Each s In sr
For Each eff In s.EffectsIf Not s.Effects.LensEffect Is Nothing Theneff.Clear 'clears effectsEnd IfNext eff
Next sNext iActiveDocument.EndCommandGroup
End Sub