標題: [發問] PPT隨機播放 [打印本頁]

---

作者: ychuang    時間: 2017-7-1 22:02     標題: PPT隨機播放

請問如何讓已做好的PPT隨機播放不同頁面的投影片?

---

作者: ychuang    時間: 2017-7-2 02:12

本帖最後由 ychuang 於 2017-7-2 02:14 編輯

試著用VBA實作這個功能。
取得投影片總頁數，產生不重覆的亂數排序，再依此排序去播放(排除首頁)。

但如何實作新需求？
如何在中途按ESC或Ctrl+C結束放映?

Private Sub Image1_Click()
    Dim aRandomArray(), aTempArray() As Integer
    Dim iSlideCount As Integer, iRandomNumber As Integer, i As Integer
   
    iSlideCount = ActivePresentation.Slides.Count                    'Get count of slides
    ReDim aTempArray(iSlideCount), aRandomArray(0 To iSlideCount, 1 To 1) 'Redeclare array size
   
    'Initialize Temp Array with count-up integer
    For i = 0 To iSlideCount - 1
        aTempArray(i) = i
    Next i
   
    'Generate random number based on iSlideCount
    Randomize (Timer)
    For i = iSlideCount - 1 To 0 Step -1
        iRandomNumber = Int(i * Rnd)
        aRandomArray(iSlideCount - i, 1) = aTempArray(iRandomNumber) + 1
        If aRandomArray(iSlideCount - i, 1) > 1 Then SlideShowWindows(1).View.GotoSlide aRandomArray(iSlideCount - i, 1) 'Pass first title slide
        aTempArray(iRandomNumber) = aTempArray(i)
    Next i
   
    SlideShowWindows(1).View.GotoSlide 1    'Return to first slide
    SlideShowWindows(Index:=1).View.Exit    'End of presentation
End Sub

---

作者: ychuang    時間: 2017-7-3 01:53

完成了，功能如下:
1. 自動播放PPT會停留在首頁
2. 當按下 Image 物件後，開始隨機播放不重覆頁面的投影片
    (播放間隔 2 秒)
3. 按 ESC 或 Ctrl+C 即可結束播放。
(適用於 32-bit 和 64-bit 的系統)

#If VBA7 And Win64 Then
    Private Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
    Private Declare PtrSafe Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Integer
#Else
    Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
    Private Declare Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Integer
#End If

Private Sub Image1_Click()
    Dim aRandomArray(), aTempArray() As Integer
    Dim iSlideCount As Integer, iRandomNumber As Integer, i As Integer
    Dim iKey As Integer
   
    iSlideCount = ActivePresentation.Slides.Count                    'Get count of slides
    ReDim aTempArray(iSlideCount), aRandomArray(0 To iSlideCount, 1 To 1) 'Redeclare array size
   
    'Initialize aTempArray with count-up integer
    For i = 0 To iSlideCount - 1
        aTempArray(i) = i
    Next i
   
    'Generate random number based on iSlideCount
    Randomize (Timer)
    For i = iSlideCount - 1 To 0 Step -1
        iRandomNumber = Int(i * Rnd)
        aRandomArray(iSlideCount - i, 1) = aTempArray(iRandomNumber) + 1
        If aRandomArray(iSlideCount - i, 1) > 1 Then SlideShowWindows(1).View.GotoSlide aRandomArray(iSlideCount - i, 1) 'Bypass first title slide
        
        'Press [ESC] key or combined [Ctrl+C] keys to cancel the presentation
        If GetAsyncKeyState(vbKeyEscape) Or (GetAsyncKeyState(vbKeyControl) & GetAsyncKeyState(vbKeyC)) Then Exit For
        Sleep( 2 * 1000)    'Delay 2 seconds
        aTempArray(iRandomNumber) = aTempArray(i)
    Next i
   
    SlideShowWindows(1).View.GotoSlide 1    'Return to first slide
    SlideShowWindows(Index:=1).View.Exit    'End of presentation
End Sub

---

歡迎光臨 麻辣家族討論版版 (http://forum.twbts.com/)