PPT根据节自动生成目录

alt+F11，插入模块，粘贴代码

Sub InsertSectionTOCAtCursor()
    Dim pptPres As Presentation
    Dim tocText As String
    Dim sectionIndex As Integer
    Dim sectionName As String
    Dim firstSlideIndex As Integer
    Dim slideNumber As Integer
    Dim currentTextRange As textRange
    
    ' 获取当前演示文稿
    Set pptPres = Application.ActivePresentation
    
    ' 初始化目录文本
    tocText = "" ' 不再需要“目录”和空行
    
    ' 遍历所有节
    For sectionIndex = 1 To pptPres.SectionProperties.Count
        ' 获取节的名称
        sectionName = pptPres.SectionProperties.Name(sectionIndex)
        
        ' 获取该节的第一个幻灯片的索引
        firstSlideIndex = pptPres.SectionProperties.FirstSlide(sectionIndex)
        
        ' 获取该节第一个幻灯片的页码
        slideNumber = pptPres.Slides(firstSlideIndex).slideNumber
        
        ' 将节名和页码添加到目录文本中，格式为“节名 页码”
        ' tocText = tocText & sectionName & " " & slideNumber & vbCrLf
        tocText = tocText & sectionName & vbCrLf
    Next sectionIndex
    
    ' 去掉最后一个vbCrLf
    If Len(tocText) > 0 Then
        tocText = Left(tocText, Len(tocText) - Len(vbCrLf))
    End If
    
    
    ' 检查当前是否有选中的文本框
    On Error Resume Next
    Set currentTextRange = Application.ActiveWindow.Selection.textRange
    On Error GoTo 0
    
    ' 如果当前有选中的文本框，则在光标处插入目录文本
    If Not currentTextRange Is Nothing Then
        currentTextRange.InsertAfter tocText
        
         ' 应用双字节圆圈编号格式
        With currentTextRange.ParagraphFormat.Bullet
            .Visible = True
            .Type = ppBulletNumbered
            .Style = ppBulletCircleNumDBPlain
        
        End With
        
    Else
    	' 如果没有进入光标编辑模式，弹出提示框
        MsgBox "请先进入光标编辑模式", vbExclamation, "提示"
    End If
End Sub

操作：选中文本框，进入光标编辑模式，alt+f8，运行宏。
要求：每节下至少有一张幻灯片