在 VBA 中创建动画随机图像显示工具 [英] Create animated random image display tool in VBA

问题描述

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

I have a PowerPoint slide with different images. I need to create VBA code in PowerPoint that recognises all these images and fades them out one by one - except for one randomly chosen image. This last image should remain until the end, then fade out and display in the middle of the slide.

我知道如何去做，并且有使用面向对象语言 (R) 的经验，但我以前从未使用过 VBA.因此，我将不胜感激有关如何在 VBA 中执行以下任何操作的指示:

I have an idea of how to do it and have experience with object oriented languages (R) but I have never used VBA before. Therefore I would be grateful for pointers on how to do any of the following in VBA:

1. 确定活动幻灯片上的图像数量
2. 一个接一个地选择每个图像并分配一个计数器变量作为选择标签(该部分应该按照这里)
3. 创建所有分配的计数器变量的范围 A"
4. 在范围A"中选择随机数x"
5. 为范围A"中的所有计数器变量创建范围B"，除了随机数x"
6. 随机化范围B"中变量的顺序
7. 循环遍历Range B"并淡出其标签对应于出现的相应Range B"变量的图像
8. 淡出标签对应x"的图片
9. 在幻灯片中央插入标签对应x"的图片

如果识别图像或为这些图像分配标签非常困难，我也可以手动进行.但是，如果这可以自动发生会更好.如果您认为上述过程的一部分已经在其他地方进行了描述，我将不胜感激任何指针，也以链接的形式提供(恐怕由于我对 VBA 缺乏经验，我没有使用非常有效的搜索词).

If it is very difficult to recognise images or assign labels to those images I can also do so manually. However, it would be nicer if that could happen automatically. I would be grateful for any pointers, also in the form of links if you think that part of the above process is already described somewhere else (I'm afraid since I'm inexperienced in VBA I am not using very effective search terms).

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

Please find the solution (steps 8 and 9 are still missing)

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

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

In order to reset the slide to the state before running the macro (so as to be able to run it again and display another random image) the following macro needs to be run:

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

推荐答案

确定图像范围不应该太难.这会让你开始.为形状分配动画可能很棘手.您最好先复制包含所有图像的幻灯片，然后删除除随机选择的图像之外的所有图像.

Working out the range of images shouldn't be too hard. This'll get you started. Assigning animation to shapes can be tricky. You might be better off duplicating the slide with all the images then deleting all but a randomly chosen image.

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 中创建动画随机图像显示工具的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！