PowerPoint（VBA？）淡入淡出文本

Question

我尝试在PPT中使用VBA编写代码，之前在Excel中也做过一些，但是我需要帮助来完成这个任务...

我有一百多个字符串列表，我想让它们在同一页幻灯片上淡入淡出，每次显示一个字符串大约3秒钟左右。并且持续进行，直到用户通过CTRL + break停止。我已经编写了一些代码，但不确定下一步该怎么做...

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 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

我非常感谢论坛/人们提供的任何帮助..谢谢!!

Skyhawk

- user616270

---

每个模块只需要一次使用Option Explicit。 - TheEngineer

Answer 1

建议使用普通动画而非VBA。

创建两个相同的文本框，分别填入不同的文本内容，然后将其中一个渐显并将另一个渐隐。

- SLaks

Answer 2

很可惜，Sleep API命令不能让宏真正进入睡眠状态。 即使处于“睡眠”状态，宏仍会运行，并且下一个动画将出现。 VBA不是实时过程。（为了避免这个限制，您可以使用Timer API，但那是另一回事。）

所以我建议您使用普通的文本框和动画，然后再让宏复制文本框和动画。

我为您制作了一个示例PPT(M)文件。

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

打开它并启用宏功能。这不会对您造成伤害。Alt-F11键将显示源代码。

在此幻灯片中，我在第2张幻灯片中添加了一个“模型”文本框。此文本框将被复制到第3张幻灯片上，包括动画效果。好处是您可以更改字体、大小、颜色、动画效果或任何您想要的内容。VBA还可以对形状添加效果，但需要太多的努力。

在第一张幻灯片上，按“添加”按钮，它将开始演示。 “删除”按钮将删除之前添加的所有句子。

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

你所需做的就是创建你自己的 'str()' 数组

- konahn