PowerPoint(VBA?)淡入淡出文本

时间:2011-02-14 13:44:30

标签: vba powerpoint powerpoint-vba

尝试在PPT中首次使用VBA,之前在Excel中做了一点......但是我需要一些帮助来解决这个问题......

我有一个大约一百个字符串的列表,我希望淡入淡出,在同一张幻灯片上,一次显示1或大约3秒。并继续这样做直到用户停止,即CTRL +中断。到目前为止,我有一些编码,但不知道从哪里开始......

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

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

天鹰

2 个答案:

答案 0 :(得分:3)

您应该使用普通动画而不是VBA。

制作两个具有不同文本的相同文本框,然后淡入并淡出另一个。

答案 1 :(得分:0)

不幸的是,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()'阵列