PowerPoint目录

Question

我需要你:我应该在我的PowerPoint演示文稿中插入一个动态索引(它也会更新与标题相关的页码)。

我在网上搜索过，但没有找到任何解决方案；唯一接近的是使用基于超文本链接的VBA宏(下面的代码)：当宏启动时，它更新索引中的页码，但随后该链接被删除，因此需要手动重新插入它。

有什么方法可以使这个过程自动化吗？谢谢。

Sub TableOfContentUpdater()
    Dim pTableOfContent As Slide
    Set pTableOfContent = ActivePresentation.Slides(2)
    
    For Each pHyperLink In pTableOfContent.Hyperlinks
        Dim pLinkNumber As String
        Dim pLinkedSlide As Slide
        pLinkNumber = Left(pHyperLink.SubAddress, InStr(pHyperLink.SubAddress, ",") - 1)
        pHyperLink.TextToDisplay = ActivePresentation.Slides.FindBySlideID(CLng(pLinkNumber)).SlideIndex
    Next pHyperLink
End Sub

Answer 1

我开发了一个脚本，用于从零开始在PowerPoint中生成一个完整的内容表，该脚本循环遍历所有幻灯片，并组装它们的标题文本及其相对幻灯片号，并应用适当的超链接。以下是代码：

    For slideNum = 1 To ActivePresentation.Slides.Count
        If slideNum > 1 Then
            If ActivePresentation.Slides(slideNum).Shapes.HasTitle Then
                slideHeader = ActivePresentation.Slides(slideNum).Shapes.Title.TextFrame.TextRange.Text & "..........................................................................." & "slide: " & slideNum + 1
                TOC_SlideList = TOC_SlideList & slideHeader & vbCrLf
            End If
        End If
    Next
    Set TOC = ActivePresentation.Slides.Add(2, ppLayoutText)
    TOC.Shapes(1).TextFrame.TextRange = "Table of Contents"
    TOC.Shapes(2).TextFrame.TextRange = TOC_SlideList
    For slideNum = 1 To ActivePresentation.Slides.Count
        If slideNum > 2 Then
            If ActivePresentation.Slides(slideNum).Shapes.HasTitle Then
                slideHeader = ActivePresentation.Slides(slideNum).Shapes.Title.TextFrame.TextRange.Text
                With TOC.Shapes(2).TextFrame.TextRange.Paragraphs(slideNum - 2).Find("slide: " & slideNum).ActionSettings(ppMouseClick)
                    .Action = ppActionHyperlink
                    .Hyperlink.Address = ""
                    .Hyperlink.SubAddress = ActivePresentation.Slides(slideNum).SlideID & "," & ActivePresentation.Slides(slideNum).SlideIndex & "," + slideHeader
                End With
            End If
        End If
    Next
End Sub

上面的代码产生以下结果：

结合这个示例和您的用例，我们可以遍历并映射数组列表中的超链接名称、幻灯片索引和目的地。然后，我们可以使用数组适当地更新链接。

下面是示例代码：

Sub TableOfContentUpdater()
    Dim pTableOfContent As Slide
    Set pTableOfContent = ActivePresentation.Slides(2)
    Dim pLinkNumber As String
    Dim pLinkedSlide As Slide
    Dim pHyperLink As Hyperlink
    ReDim subAddresses(pTableOfContent.Hyperlinks.Count - 1) As Variant
    ReDim oldNames(pTableOfContent.Hyperlinks.Count - 1) As Variant
    ReDim newNames(pTableOfContent.Hyperlinks.Count - 1) As Variant
    Dim i As Integer
    For Each pHyperLink In pTableOfContent.Hyperlinks
        subAddresses(i) = pHyperLink.SubAddress
        pLinkNumber = Left(pHyperLink.SubAddress, InStr(pHyperLink.SubAddress, ",") - 1)
        newNames(i) = ActivePresentation.Slides.FindBySlideID(CLng(pLinkNumber)).SlideIndex
        pHyperLink.TextToDisplay = newNames(i)
        i = i + 1
    Next pHyperLink
    i = 0
    For Each pHyperLink In pTableOfContent.Hyperlinks
        pHyperLink.Delete
        i = i + 1
    Next pHyperLink
    i = 0
    For Each pSubAddress In subAddresses
        With pTableOfContent.Shapes(2).TextFrame.TextRange.Paragraphs(i + 1).Find(newNames(i)).ActionSettings(ppMouseClick)
            .Action = ppActionHyperlink
            .Hyperlink.Address = ""
            .Hyperlink.SubAddress = pSubAddress
        End With
    i = i + 1
   Next pSubAddress
End Sub

当应用于上面创建的电子表格时，结果是：

​