问如何使用幻灯片计时和标题为powerpoint视频制作生成YouTube索引？

EN

Sub PowerPointYouTubeTiming()
' Copyright/Last Edited 11 December, 2019 by Stepen Rindsberg dba PPTools
' Modified by T Delbruck for powerpoint youtube timing 26.8.2020

Dim oSld As Slide
Dim strMessage As String
Dim lngTotalTime As Long


lngTotalTime = 0
' Use this to collect times for ALL slides:
For Each oSld In ActivePresentation.Slides
' Or comment it out and uncomment this to get just the selected slides:
' For Each oSld in ActiveWindow.Selection.SlideRange
    strMessage = strMessage _
        & Format(lngTotalTime \ 3600, "00") & ":" & Format((lngTotalTime Mod 3600) \ 60, "00") & ":" & Format(lngTotalTime Mod 60, "00") _
        & vbTab _
        & CStr(oSld.SlideNumber) _
        & vbTab
    If oSld.Shapes.HasTitle Then
        strMessage = strMessage _
            & oSld.Shapes.Title.TextFrame.TextRange.Text & vbCrLf
    Else
        strMessage = strMessage & vbCrLf
    End If
    lngTotalTime = lngTotalTime + oSld.SlideShowTransition.AdvanceTime
    
Next oSld

' Comment these out if you don't want to see them
' MsgBox strMessage
' MsgBox ("Total time: " & CStr(lngTotalTime))

' And if you want to write the results to a text file:
Dim FileNum As Integer
Dim FileName As String

' Edit this to suit, especially if you use a Mac:
' As written, it'll pick up your TEMP folder location automatically:
FileName = Environ$("TEMP") & "\" & "YouTubeTimings.txt"

FileNum = FreeFile()
Open FileName For Output As FileNum
Print #FileNum, strMessage
' Print #FileNum, "Total time: " & Format((lngTotalTime), "hh:mm:ss")
Close #FileNum
' view the file in notepad
Call Shell("Notepad.exe " & FileName, vbNormalFocus)
' or if you use a mac, comment that out and open the file in any text editor you like

End Sub

00:00:00    1   Title
00:00:56    2   heading slide 2
00:01:57    3   Your heading slide 3