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

Question

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

我知道如何去做，并且有使用面向对象语言 (R) 的经验，但我以前从未使用过 VBA。因此，我将不胜感激关于如何在 VBA:

中执行以下任何操作的指示

确定活动幻灯片上的图像数量
Select 每个图像一个接一个，并分配一个计数器变量作为选择标签（该部分应按描述工作here）
创建 "Range A" 所有分配的计数器变量
Select随机数"x"在"Range A"
创建 "Range B" "Range A" 中的所有计数器变量，除了随机数 "x"
随机化"Range B"
遍历 "Range B" 并淡出其标签对应于出现的相应 "Range B" 变量的图像
淡出标签对应"x"
在幻灯片中间插入标签对应"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

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

Create animated random image display tool in VBA

powerpoint

vba