2011-02-14 84 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()」陣列