[發問] PPT隨機播放

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

樓主熱帖

ychuang

　暱稱: 祈為黃文子

中學生 Rank: 2

帖子: 8
主題: 3
精華: 0
積分: 50
點名: 0
作業系統: Windows 7
軟體版本: Office 2013
閱讀權限: 20
性別: 男
註冊時間: 2017-6-6
最後登錄: 2018-8-27

2^#

發表於 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

TOP

ychuang

　暱稱: 祈為黃文子

中學生 Rank: 2

帖子: 8
主題: 3
精華: 0
積分: 50
點名: 0
作業系統: Windows 7
軟體版本: Office 2013
閱讀權限: 20
性別: 男
註冊時間: 2017-6-6
最後登錄: 2018-8-27

3^#

發表於 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

TOP