find position of entrance/dissolve text ?

[Geoff Cox]

Hello,

The code below finds words with entrance/dissolve animation and
deletes them and then inserts an ActiveX text box control.

Problem is - I want to place the new text box in the position
previously occupied by the entrance/dissolve words.

How do I find their position?

Cheers

Geoff

Sub activex_here(strMyFile)

Dim oPresentation As Presentation
Set oPresentation = Presentations.Open(strMyFile)
Dim oSl As Slide
Dim oSh As shape

For Each oSl In oPresentation.Slides

With oSl.TimeLine

For I = .MainSequence.Count To 1 Step -1

If .MainSequence(I).shape.Type = msoTextBox Then
If .MainSequence(I).shape.AnimationSettings.EntryEffect _
= ppEffectDissolve Then

.MainSequence(I).shape.Delete

With oSl.Shapes
.AddOLEObject _
Left:=72, _
Top:=72, _
Height:=36, _
Width:=144, _
ClassName:="Forms.TextBox.1", _
Link:=msoFalse
End With

End If
End If

Next I

End With

Next oSl

oPresentation.Save
oPresentation.Close


End Sub

 

[Geoff Cox]

Problem is - I want to place the new text box in the position
previously occupied by the entrance/dissolve words.

I think I may have sorted this - but any comments welcome!

Geoff

Sub activex_here(strMyFile)

Dim oPresentation As Presentation
Set oPresentation = Presentations.Open(strMyFile)
Dim oSl As Slide
Dim oSh As shape
Dim posLeft As Long
Dim posTop As Long
Dim posWidth As Long
Dim posHeight As Long


For Each oSl In oPresentation.Slides

With oSl.TimeLine

For I = .MainSequence.Count To 1 Step -1

If .MainSequence(I).shape.Type = msoTextBox Then
If .MainSequence(I).shape.AnimationSettings.EntryEffect _
= ppEffectDissolve Then

posLeft = .MainSequence(I).shape.Left
posTop = .MainSequence(I).shape.Top
posWidth = .MainSequence(I).shape.Width
posHeight = .MainSequence(I).shape.Height

'MsgBox "Left = " & posLeft


.MainSequence(I).shape.Delete

With oSl.Shapes
.AddOLEObject _
Left:=posLeft, _
Top:=posTop, _
Height:=posHeight, _
Width:=posWidth, _
ClassName:="Forms.TextBox.1", _
Link:=msoFalse
End With

End If
End If

Next I

End With

Next oSl

oPresentation.Save
oPresentation.Close


End Sub