使用VBA随机切换幻灯片

2023-08-30 08:39:20 浏览数 (1)

标签:VBA,PowerPoint编程

本文介绍让幻灯片能够随机切换的VBA代码。

在PowerPoint中,打开VBE,插入一个标准模块,在其中输入下面的代码:

代码语言:javascript复制
Sub RandomSlides()
 Dim i As Long
 Dim FirstSlide As Long
 Dim LastSlide As Long
 Dim RndSlide As Long
 
 FirstSlide = 2
 LastSlide = 6
 
 Randomize
 
 For i = FirstSlide To LastSlide
   RndSlide = Int((LastSlide - FirstSlide   1) * Rnd   FirstSlide)
   ActivePresentation.Slides(i).MoveTo (RndSlide)
 Next i
End Sub

代码中,假设只有5张需要随机切换的幻灯片,如果你的幻灯片数量不只这些,可以结合实际调整变量FirstSlide和LastSlide的值。

这样,每次运行RandomSlides过程后,幻灯片的顺序都会变化。你可以在第一张幻灯片中绘制一个形状,然后关联该过程,如下图1所示。

图1

选取绘制的形状,单击功能区“插入”选项卡“链接”组中的“动作”按钮,在弹出的“操作设置”对话框中,选取“运行宏”单选按钮并从下拉列表中选取RandomSlides过程,如下图2所示。

图2

这样,每次放映该PPT时,单击第一页中的箭头,就会按不同的顺序放映幻灯片。

如果只想随机放映偶数幻灯片或奇数幻灯片,那么可以使用以下VBA代码:

代码语言:javascript复制
Sub RandomEvenSlides()
 Dim i As Long
 Dim FirstSlide As Long
 Dim LastSlide As Long
 Dim RndSlide As Long
 Dim EvenSlide As Boolean
 
 'False则仅奇数幻灯片随机排列
 EvenSlide = True
 
 FirstSlide = 2
 LastSlide = 6
 
 Randomize
 
 For i = FirstSlide To LastSlide Step 2
Generate:
   RndSlide = Int((LastSlide - FirstSlide   1) * Rnd   FirstSlide)
   If EvenSlide = True Then
     If RndSlide Mod 2 = 1 Then GoTo Generate
   Else
     If RndSlide Mod 2 = 0 Then GoTo Generate
   End If
   ActivePresentation.Slides(i).MoveTo (RndSlide)
   If i < RndSlide Then ActivePresentation.Slides(RndSlide - 1).MoveTo (i)
   If i > RndSlide Then ActivePresentation.Slides(RndSlide   1).MoveTo (i)
 Next i
End Sub

下面的VBA代码将反转PPT中的幻灯片,即颠倒幻灯片顺序:

代码语言:javascript复制
Sub ReverseSlideOrder()
 Dim i As Long
 
 For i = 2 To 6
   ActivePresentation.Slides(6).MoveTo (i)
 Next i
End Sub

可以在幻灯片放映模式下自动无限循环浏览所有幻灯片,每次循环都有一个新的随机顺序,VBA代码如下:

代码语言:javascript复制
Public Position As Integer
Public Range As Integer
Public AllSlides() As Integer
Sub ShuffleAndBegin()
 Dim i As Integer
 Dim j As Integer
 Dim n As Integer
 Dim temp As Integer
 Dim FirstSlide As Integer
 Dim LastSlide As Integer
 Dim RndSlide As Integer
 Dim EvenSlide As Boolean
 '根据实际修改值
 FirstSlide = 2
 LastSlide = 6
 Range = (LastSlide - FirstSlide)
 ReDim AllSlides(0 To Range)
 For i = 0 To Range
   AllSlides(i) = FirstSlide   i
 Next i
 Randomize
 For n = 0 To Range
   j = Int((Range   1) * Rnd)
   temp = AllSlides(n)
   AllSlides(n) = AllSlides(j)
   AllSlides(j) = temp
 Next n
 Position = 0
 ActivePresentation.SlideShowWindow.View.GotoSlide AllSlides(Position)
End Sub
Sub Advance()
 Position = Position   1
 If Position > Range Then
   ShuffleAndBegin
 Else
   ActivePresentation.SlideShowWindow.View.GotoSlide AllSlides(Position)
 End If
End Sub

标题幻灯片必须带有一个运行ShuffleAndBegin过程并初始化代码的按钮。

在我们的范围内所有将被打乱的幻灯片中,必须在所有这些幻灯片上放置一个形状,并且该形状必须在单击时运行Advance过程。随机幻灯片的第一个循环将在单击形状时出现。第一个循环结束后,幻灯片将再次洗牌,单击该形状后,将出现新随机循环的下一张幻灯片。

有兴趣的朋友,可以在完美Excel公众号中发送消息:

随机幻灯片

获取示例PPT下载链接。

或者,直接到知识星球App完美Excel社群下载示例PPT。

0 人点赞