PowerPoint (VBA?) fading in and out text

Attempting my first go at VBA within PPT, done a little in Excel before.. but I need some help on where to go with this one...

I have a list of a hundred or so strings, that I want to fade in and out, on the same slide after about 3 or secounds of displaying 1 at a time. And to keep doing it until stopped by the user ie CTRL + break. I have a a little of the coding so far, but not sure where to go from here...

Option Explicit
Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Sub Test()
'Start the presentation
ActivePresentation.SlideShowSettings.Run

'Change the value of the text box to String1 and fade in the text
ActivePresentation.Slides(1).Shapes(1).TextFrame.TextRange.Text = "String1"

DoEvents

'Wait 2 secounds, fade out the Hello! Sting

Sleep 2000

'Fade in the new string.. String2!
 ActivePresentation.Slides(1).Shapes(1).TextFrame.TextRange.Text = "String2"

DoEvents

'A Loop to keep going back and forth between the 2 (there will be many more later....
'Until stoped by the user [CTRL + BREAK]

End Sub

Option Explicit
Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

Sub Test()
'Start the presentation
ActivePresentation.SlideShowSettings.Run

'Change the value of the text box to String1 and fade in the text
ActivePresentation.Slides(1).Shapes(1).TextFrame.TextRange.Text = "String1"

DoEvents
'Wait 2开发者_StackOverflow社区 secounds, fade out the Hello! Sting

Sleep 2000

'Fade in the new string.. String2!
ActivePresentation.Slides(1).Shapes(1).TextFrame.TextRange.Text = "String2"

DoEvents

'A Loop to keep going back and forth between the 2 (there will be many more later....
'Until stoped by the user [CTRL + BREAK]

End Sub

I really appreciate any help the forum / people can provide.. thank you!!

Skyhawk

---

You should use normal animation instead of VBA.

Make two identical textboxes with different texts, then fade in on and fade out the other.

---

Unfortunately, the Sleep API command won't make the macro really fall asleep. Even in 'Sleeping', the macro will run and the next animation will appear. VBA is not a real-time procedure. (To avoid this limitation, you can use a Timer API but it's another story.)

So I recommend you to use a normal textbox and animation and let the macro to copy the textbox and animation.

I made a sample PPT(M) file for you

https://drive.google.com/file/d/0ByoPCwQXKo0HVGhZOVJvYkJwak0/view

Open it and enable the Macro functionality. It won't harm you. Alt-F11 key will show you the source.

In this slide, I added a 'model' textbox in the slide 2. This textbox will be copied onto slide 3 including the animation effect. The good thing is that you can change the font, size, color, animation effect or whatever you want. VBA can also add an effect on a shape but it requires too much effort.

On the first slide, press 'Add' button and it will start the show. 'Remove' button removes all the added sentences that were added before.

Option Base 1
Const MAX = 10

Sub Add()
    Dim shp As Shape
    Dim str() As String
    Dim i As Integer

    'First, remove sentences that were added before
    Remove

    ' Initialize str() array
    ReDim str(MAX)
    For i = 1 To MAX
        str(i) = "This is the sentence #" & i
    Next i

    'Let's copy the textbox on Slide #2 onto Slide #3
    Set shp = ActivePresentation.Slides(2).Shapes("TextBox 1")
    shp.Copy
    For i = 1 To UBound(str)
        With ActivePresentation.Slides(3).Shapes.Paste
            .Left = shp.Left
            .Top = shp.Top
            .TextFrame.TextRange.Text = str(i)
            .Name = "TextBox " & i
        End With
    Next i

    'Message
    MsgBox "Total " & i - 1 & " sentence(s) has(have) been added."

    'go to the Slide #3
    SlideShowWindows(1).View.GotoSlide 3
End Sub


Sub Remove()
    Dim i As Integer, cnt As Integer

    With ActivePresentation.Slides(3)
        'When deleting, be sure to delete shapes from the top. Otherwise, some shapes might survive
        For i = .Shapes.Count To 1 Step -1
            If Left(.Shapes(i).Name, 8) = "TextBox " Then
                .Shapes(i).Delete
                cnt = cnt + 1
            End If
        Next i
    End With

    If cnt > 0 Then MsgBox "Total " & cnt & " sentence(s) has(have) been removed."
End Sub

All you have to do is to make your own 'str()' array