尝试在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
我非常感谢论坛/人们提供的任何帮助..谢谢!!
天鹰
答案 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()'阵列