在VBA中创建动画随机图像显示工具

Question

我有一张带有不同图像的PowerPoint幻灯片。我需要在PowerPoint中创建VBA代码，识别所有这些图像，并将它们逐一淡出——除了一个随机选择的图像。最后一张图像应该保留到最后，然后淡出并显示在幻灯片的中间。

我知道如何做到这一点，并且有面向对象语言(R)的经验，但我以前从未使用过VBA。因此，我将感谢有关如何在VBA中执行以下任何操作的提示：

1. 确定活动幻灯片上的图像数量
2. 依次选择每个图像，并指定一个计数器变量作为选择标签(该部分应按此处所述工作)
3. 创建所有指定计数器变量的"范围A">
4. 在"范围A"中选择随机数"x">
5. 创建"范围A"中所有计数器变量的"范围B"，随机数"x"除外
6. 随机排列"范围B"中的变量顺序
7. 循环浏览"范围B"和淡出图像，其标签对应于出现的相应"范围B)变量
8. 淡出标签对应于"x"的图像
9. 在幻灯片中心插入标签与"x"对应的图像

如果很难识别图像或为这些图像分配标签，我也可以手动识别。然而，如果这能自动发生，那就更好了。如果你认为上面的过程已经在其他地方描述过了，我将非常感谢任何指针，也可以是链接的形式(恐怕由于我在VBA方面缺乏经验，我没有使用非常有效的搜索词)。

编辑：请找到解决方案(步骤8和9仍然缺失)

Sub SelectionMacro()
Dim oSl As Slide
Dim oSh As Shape
Dim aArrayOfShapes() As Variant
Dim ShapeX As Shape
Dim N As Long
Dim Temp As Variant
Dim J As Long
Dim FadeEffect As Effect
Set oSl = ActivePresentation.SlideS(1)
'This section creates an array of all pictures on Slide1 called
'"aArrayOfShapes"
For Each oSh In oSl.Shapes
If oSh.Type = msoPicture Then
On Error Resume Next
Debug.Print UBound(aArrayOfShapes)
If Err.Number = 0 Then
ReDim Preserve aArrayOfShapes(1 To UBound(aArrayOfShapes) + 1)
Else
ReDim Preserve aArrayOfShapes(1 To 1)
End If
Set aArrayOfShapes(UBound(aArrayOfShapes)) = oSh
End If
Next
'This section creates a random index number within the bounds of the
'length of aArrayOfShapes and assigns the shape with that index number
'to the Shape object ShapeX
Randomize
NumberX = Int((UBound(aArrayOfShapes) - (LBound(aArrayOfShapes) - 1)) * Rnd) + LBound(aArrayOfShapes)
Set ShapeX = aArrayOfShapes(NumberX)
'This section shuffles aArrayOfShapes
For N = LBound(aArrayOfShapes) To UBound(aArrayOfShapes)
J = CLng(((UBound(aArrayOfShapes) - N) * Rnd) + N)
If N <> J Then
Set Temp = aArrayOfShapes(N)
Set aArrayOfShapes(N) = aArrayOfShapes(J)
Set aArrayOfShapes(J) = Temp
End If
Next N
'This section loops through all Shapes in aArrayOfShapes and
'fades them out one by one EXCEPT for ShapeX
For Each Shape In aArrayOfShapes
If ShapeX.Name <> Shape.Name Then
Set FadeEffect = oSl.TimeLine.MainSequence.AddEffect _
(Shape:=Shape, effectid:=msoAnimEffectFade, trigger:=msoAnimTriggerAfterPrevious)
With FadeEffect
.Timing.Duration = 0.5
.Exit = msoTrue
End With
End If
Next Shape
End Sub

为了将幻灯片重置为运行宏之前的状态(以便能够再次运行并显示另一个随机图像)，需要运行以下宏：

Sub ResetSelection()
For i = ActivePresentation.SlideS(1).TimeLine.MainSequence.Count To 1 Step -1
ActivePresentation.SlideS(1).TimeLine.MainSequence(i).Delete
Next i
End Sub

Answer 1

计算图像的范围应该不会太难。这会让你开始。为形状指定动画可能很棘手。您最好复制幻灯片中的所有图像，然后删除随机选择的图像以外的所有图像。

Dim oSl As Slide
Dim oSh As Shape
' Dynamic array of shapes to hold shape references
Dim aArrayOfShapes() As Shape
Set oSl = ActiveWindow.Selection.SlideRange(1)
For Each oSh In oSl.Shapes
If oSh.Type = msoPicture Then
On Error Resume Next
Debug.Print UBound(aArrayOfShapes)
If Err.Number = 0 Then
ReDim Preserve aArrayOfShapes(1 To UBound(aArrayOfShapes))
Else
ReDim Preserve aArrayOfShapes(1 To 1)
End If
Set aArrayOfShapes(UBound(aArrayOfShapes)) = oSh
End If
Next`enter code here`

' Now you have an array containing references to all the pictures
' on the slide.  You can use a random number function to return
' an index into the array to choose a picture at random.
With aArrayOfShapes(RandomNumberFunction(LBound(aArrayOfShapes), UBound(aArrayOfShapes)))
' google to find an appropriate function; they're out there
' do whatever you need to do with your shapes here
End With