最近有一個工作是要將 PowerPoint 簡報內容輸出成影片，而且影片長度必須要控制為指定的時間長度，該如何來處理？
1.規劃時間(秒數)
配合投影片的內容，先在Excel裡規畫每個投影片的秒數，再利用公式計算累積秒數和總秒數，以利規劃時的運用。
總秒數計算公式：
="總秒數："&SUM(B3:B27,H3:H27,N3:N27)&"秒="&INT(SUM(B3:B27,H3:H27,N3:N27)/60)&"分"&MOD(SUM(B3:B27,H3:H27,N3:N27),60)&"秒"
累積秒數計算公式，以儲存格O3為例：
=INT(SUM($B$3:$B$27,$H$3:$H$27,$N$3:N3)/60)&":"&MOD(SUM($B$3:$B$27,$H$3:$H$27,$N$3:N3),60)
2.設定時間(秒數)
依以上的規劃，將每張投影片秒數設定至投影片換頁秒數。
1.切換至「轉場」功能表，在「投影片換頁」中勾選「每隔」，並輸入要設定的秒數。
2.如果轉場效果是無，則直接設定規劃的秒數，如果有設定轉場，則必須扣減轉場所花時間(秒數)。
3.檢核校正
你如何確認設定的秒數是正確的？
我請ChatGPT產生一個VBA程式為我輸出每一張投影片的秒數讓我核對。ChatGPT提供我以下的程式：
Sub GenerateSlidesDurationReport()
Dim filePath As String
Dim fileNo As Integer
Dim slide As slide
Dim totalDuration As Single
Dim slideDuration As Single
Dim report As String
' 設置報表文件的路徑
filePath = Environ$("USERPROFILE") & "\Desktop\SlidesDurationReport.txt"
' 開始寫入報表
fileNo = FreeFile
Open filePath For Output As #fileNo
Print #fileNo, "投影片播放時間報表"
Print #fileNo, "--------------------------------"
For Each slide In ActivePresentation.Slides
With slide
slideDuration = .SlideShowTransition.AdvanceTime
totalDuration = totalDuration + slideDuration
report = "投影片 " & .SlideIndex & ": " & slideDuration & " 秒"
Print #fileNo, report
End With
Next slide
' 輸出總播放時間
Print #fileNo, "--------------------------------"
Print #fileNo, "總播放時間: " & totalDuration & " 秒"
' 關閉檔案
Close #fileNo
' 顯示報表已生成的訊息
MsgBox "播放時間報表已生成於桌面上。", vbInformation
End Sub
------------------------------------------------------------
複製這個程式碼，然後：
(1)切換至「開發人員」功能表，可以至「選項」的自訂功能區中勾選：開發人員，功能表中就會有「開發人員」。
(2)點選「Visual Basic」圖示，再選取「插入／組組」。
(3)貼上程式碼。
(4)點選「執行」圖示。
接著，會在你的電腦桌面上產生一個文字檔(SlidesDurationReport.txt)，內容有每張投影片的秒數，可以用來核對是否有正確設定。
4.輸出影片
(1)點選「檔案／匯出」。
(2)點選「建立視訊」。
(3)在「每張投影片所用秒數」中設定為「0」。
(4)建立視訊。
結果應該就如你所願了！本例的輸出比預定的15分鐘多了2秒，應該是在某一張投影片內容裡的播放影片秒數，超過了投影片設定換頁秒數造成。
我使用新的指令，請ChatGPT產生每張投影片播放時間和轉場時間的報表。得到新的VBA程式碼：
Sub GeneratePresentationTimingReportOnDesktop()
Dim slideIndex As Integer
Dim slideTiming As Single
Dim transitionTiming As Single
Dim totalTiming As Single
Dim reportText As String
Dim desktopPath As String
Dim filePath As String
' 獲取桌面路徑
desktopPath = CreateObject("WScript.Shell").SpecialFolders("Desktop")
' 初始化報告文本
reportText = "Slide #, Slide Timing (s), Transition Timing (s)" & vbCrLf
' 遍歷演示文稿中的每一張幻燈片
For slideIndex = 1 To ActivePresentation.Slides.Count
With ActivePresentation.Slides(slideIndex)
' 獲取幻燈片播放和過渡時間
slideTiming = .SlideShowTransition.AdvanceTime
transitionTiming = .SlideShowTransition.Duration
totalTiming = totalTiming + slideTiming + transitionTiming
' 添加到報告文本中
reportText = reportText & slideIndex & ", " & slideTiming & ", " & transitionTiming & vbCrLf
End With
Next slideIndex
' 添加總播放時間到報告文本中
reportText = reportText & vbCrLf & "Total Presentation Time: " & totalTiming & " seconds"
' 設置報告文件的完整路徑
filePath = desktopPath & "\PresentationTimingsReport.txt"
' 將報告寫入到文本文件中
Dim fileNumber As Integer
fileNumber = FreeFile
Open filePath For Output As #fileNumber
Print #fileNumber, reportText
Close #fileNumber
' 彈出消息框通知用戶報告已生成
MsgBox "Presentation timings report has been generated on your desktop: " & filePath
End Sub
留言列表