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.
Private Sub CommandButton1_Click()
Optimization = True
Dim sr As ShapeRange, s As Shape
Set sr = ActivePage.FindShapes()
If sr.count = 0 Then
MsgBox "No Lens objects found."
For Each s In sr
If s.Transparency.Type <> cdrNoTransparency Then s.Transparency.ApplyNoTransparency
Optimization = False
You might be able to modify this?
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
For me cdrLensTransparency did not work...
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
You can use CQL to find the shapes. Then loop your ShapeRange to output a list.
Dim srTransparency As ShapeRange, s As Shape
Dim p As Page
For Each p In ActiveDocument.Pages
Set srTransparency = p.Shapes.FindShapes(Query:="@com.transparency.type <> 0")
For Each s In srTransparency.Shapes
I tried all of these methods and not luck.
In which version of CorelDRAW are you testing these codes?