magnify text animation

  • Thread starter Thread starter RBDU
  • Start date Start date
R

RBDU

Hi All! Thanking anyone for a reply. PP2003.

I want to pass a circle/ring (nil fill colour) over my text, left to right.
And as it does it magnifies the text it is going over. Can this be done.
Have tried but failed.

Regards Peter
 
RBDU said:
Hi All! Thanking anyone for a reply. PP2003.

I want to pass a circle/ring (nil fill colour) over my text, left to right.
And as it does it magnifies the text it is going over. Can this be done.
Have tried but failed.

Regards Peter
Click to expand...

Hello RBDU,
If you can supply us with the size of textbox, where it is on the
slide, the size of the ring, and the font size(but before magnification
and after) we could make a short VBA routine to get started. Some
changes may need to be made as you see the results.
Eldon
 
Hi 2 ! (e-mail address removed)


Size text box : H 1.3cm W 20cm
Text box Location: centre
Size of ring; H 3.4cm W 3.4cm
Font Size before: 23
Font Size during magnification: 44

The ring will first appear to the left of the text box and with a motion
path move to the right and finish outside the text box on the right.

Regards Peter
 
RBDU said:
Hi 2 ! (e-mail address removed)


Size text box : H 1.3cm W 20cm
Text box Location: centre
Size of ring; H 3.4cm W 3.4cm
Font Size before: 23
Font Size during magnification: 44

The ring will first appear to the left of the text box and with a motion
path move to the right and finish outside the text box on the right.

Regards Peter
Click to expand...
Starting with a new presentation and making it from scratch so shape
names will match up. We can modify this as we go along.
***Start Code***
Public Sub sldPrep()
'Make text box, fill with text, establish font size
With ActivePresentation.Slides(1).Shapes
With .AddTextbox(msoTextOrientationHorizontal, 0, 252, 568, 36.85)
.Name = "Text Box 4"
With .TextFrame
.TextRange = " Now is the time for all good men to
come to the aid"
With .TextRange.Font
.Size = 23
End With
End With
End With
'Make magnifying lens, remove fill
With .AddShape(msoShapeOval, 0, 444, 96, 96)
.Name = "Oval 5"
.Fill.Visible = msoFalse
End With
End With
***End Code***
Once the above shapes have been drawn on the slide, make an action
setting for the magnifying lens shape. Have it run the "MagnifyText"
macro. In slide show mode, the effect will take place when the lens is
clicked. Some adjustments will to be made. Post back when you get to
that point.

***Start Code***
Public Sub MagnifyText()
Dim i As Integer
With ActivePresentation.Slides(1).Shapes("Oval 5")
.Top = 222
.Left = -36
End With
For i = 0 To 90
With ActivePresentation.Slides(1).Shapes("Oval 5")
.Left = .Left + 10
With ActivePresentation.Slides(1).Shapes("Text Box 4").TextFrame
.VerticalAnchor = msoAnchorBottom
With .TextRange
.Characters(i, 5).Font.Size = 44
.Characters(i - 5, 5).Font.Size = 23
End With
End With
End With
SlideShowWindows(1).View.GotoSlide 1
Next i
With ActivePresentation.Slides(1).Shapes("Oval 5")
.Left = 0
.Top = 444
End With
End Sub
***End Code***
 
Got it working, thanking you very very much!

Need to adjust a few things if that is OK!

1.Adjust the speed of the ring to a slower speed.

2. If I change your text what should I do so it appears on the slide.

Peter
 
RBDU said:
Got it working, thanking you very very much!

Need to adjust a few things if that is OK!

1.Adjust the speed of the ring to a slower speed.

2. If I change your text what should I do so it appears on the slide.

Peter
Click to expand...

1. I was afraid that would be a problem, will try to find a way of
looping to give it more time "under the glass."
2. Put what you need in the text box. The string needs some dead space
for the characters to catch up. That is why there are spaces at the
beginning. You won't need to do it through the macro, just go to your
slide and edit there.

Will work on the one part some and post back.
 
Thank You
Peter
1. I was afraid that would be a problem, will try to find a way of
looping to give it more time "under the glass."
2. Put what you need in the text box. The string needs some dead space
for the characters to catch up. That is why there are spaces at the
beginning. You won't need to do it through the macro, just go to your
slide and edit there.

Will work on the one part some and post back.
Click to expand...
 
RBDU said:
Thank You
Peter
Click to expand...

I am reposting the code. A number of things are different. One is the
use of "timer" to regulate the speed and another is using "DoEvents" in
the place of "SlideShowWindows(1).View.GotoSlide 1." If you send the
text that is being used in the text box, maybe we can get it looking a
bit more professional. Also, some coding practices could use a facelift
and make it easier to use universally.

****Start Code****
Public Sub MagnifyText2()
Dim i As Integer
Dim PauseTime, Start, Finish, TotalTime
PauseTime = 0.1
With ActivePresentation.Slides(1).Shapes("Oval 5")
.Top = 222
.Left = -18
End With
For i = 0 To 80
With ActivePresentation.Slides(1).Shapes("Oval 5")
.Left = .Left + 10
With ActivePresentation.Slides(1).Shapes("Text Box 4").TextFrame
.VerticalAnchor = msoAnchorBottom
With .TextRange
.Characters(i, 5).Font.Size = 44
.Characters(i - 5, 5).Font.Size = 23
End With
End With
End With
Start = Timer
Do While Timer < Start + PauseTime
DoEvents
Loop
Finish = Timer
Next i
With ActivePresentation.Slides(1).Shapes("Oval 5")
.Left = 0
.Top = 444
End With
End Sub
****End Code****
 
Looks great to me & my text will vary depending on the job.

I will continue to play with it a bit more & get back to you later if that
is OK!

Regards
Peter
 
Back
Top