2011-02-14 83 views
3

试图在我的PPT内VBA第一次去,在Excel中做了一些前..但我需要在那里与这一个去一些帮助......的PowerPoint(VBA?)淡入淡出文本

我有一百个左右的字符串的列表,我想淡入淡出,在同一张幻灯片上,大约3或者每秒钟显示1次。并继续这样做直到用户停止,即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

+0

你只需要每个模块`选项Explicit`一次。 – TheEngineer 2016-06-27 17:01:39

回答

3

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

使两个相同的文本框与不同的文本,然后淡入和淡出其他。

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()”阵列