求ppt页面乱序播放vba代码

kyocc

60页ppt，想随机播放页面，也就是乱序播放，有大神吗，求！

lss001

Sub 自定义ppt播放顺序() '随机播放
Set ppt = ActivePresentation
Const lMin = 1, lMax = 60 ' 指定播放范围
ReDim ar(lMin To lMax), br(lMin To lMax)
For i = lMin To lMax
    ar(i) = i
Next
Randomize: lEnd = lMax '产生随机数
For i = lMin To lMax
    j = Int(Rnd() * (lEnd - lMin + 1) + lMin)
    br(i) = ar(j)
    ar(j) = ar(lEnd)
    lEnd = lEnd - 1
Next
Dim ds(1 To lMax)
For i = 1 To lMax '自定义ppt/随机
    ds(i) = ppt.Slides.Item(br(i)).SlideID
Next
With ppt.SlideShowSettings '播放自定义ppt
    .NamedSlideShows.Add Name:="rndppt", SafeArrayOfSlideIDs:=ds
    .RangeType = ppShowNamedSlideShow
    .Run
End With
End Sub

chxw68

跟楼上学习的。

1. Sub test2()
   
2.   Dim i%, m%, temp%
   
3.   Dim arr
   
4.   Randomize Timer
   
5.   With Application
   
6.     With .ActivePresentation
   
7.       ReDim arr(1 To .Slides.Count)
   
8.       For i = 1 To UBound(arr)
   
9.         arr(i) = .Slides(i).SlideID
   
10.       Next
    
11.       For i = 1 To UBound(arr) - 1
    
12.         m = Int(Rnd() * (UBound(arr) - i)) + i + 1
    
13.         temp = arr(i)
    
14.         arr(i) = arr(m)
    
15.         arr(m) = temp
    
16.       Next
    
17.       With .SlideShowSettings
    
18.         .RangeType = ppShowNamedSlideShow
    
19.         With .NamedSlideShows
    
20.           For i = 1 To .Count
    
21.             If .Item(i).Name = "myppt" Then
    
22.               .Item(i).Delete
    
23.             End If
    
24.           Next
    
25.           .Add Name:="myppt", SafeArrayOfSlideIDs:=arr
    
26.         End With
    
27.         .SlideShowName = "myppt"
    
28.         .Run
    
29.       End With
    
30.     End With
    
31.   End With
    
32. End Sub
    

复制代码

rcdjh

学习一下

rcdjh

chxw68 发表于 2020-3-29 17:47
跟楼上学习的。

根据楼主的代码我实验了一下，好像每次随机的播放顺序是一样的，能不能做到每次播放的顺序都不一样？