Question

我正在使用PowerPoint 2007.我想使用列表在幻灯片上创建表格。每行的第一列将具有指向演示文稿中不同幻灯片的超链接（如摘要幻灯片）。

我在使用VBA将超链接插入单元格时遇到问题。错误消息通常类似于“对象不支持该功能”。

以下是违规行：

With pptPres.Slides(2).Shapes("Table Summary").Table.Cell(i - 1, 1).Shape.ActionSettings(ppMouseClick).Hyperlink
    .TextToDisplay = ThisWorkbook.Sheets(i).Range("B1")
    .SubAddress = pptPres.Slides(i).SlideID
End With

Answer 1

你几乎就在那里如果要在表格或形状中的文本中添加链接，则需要访问TextRange Object。
类似的东西：

Sub marine()
    Dim t As Table
    Dim pptpres As Presentation

    Set pptpres = ActivePresentation
    Set t = pptpres.Slides(1).Shapes(1).Table

    With t.Cell(2, 1).Shape.TextFrame.TextRange.ActionSettings(ppMouseClick).Hyperlink
        .TextToDisplay = "Link to Slide"
        .SubAddress = pptpres.Slides(2).SlideNumber _
            & ". " & pptpres.Slides(2).Name
    End With
End Sub

此外，您不能将 SlideID 属性用作 SubAddress 。
它应采用以下格式：<slide number><dot><space><slide name>（例如＃2。Slide2）
为此，我们使用了 SlideNumber 和 Name 属性。 HTH

Answer 2

感谢以上。下面为每个进入幻灯片2的幻灯片生成一个超链接的TOC表

Sub DeckTOC()                                                                      ' Creates a hyperlinked TOC of each slide in deck
' Tip: add a return-to-TOC hyperlink on Slidemaster default layout
' assumes slide 1 is a cover slide, slides 2 is for TOC
' and #2 already includes a table And (important) no other shapes or title
' with col 1 for slide title  and 2nd cloumn for slide no

' TOC can be formatted before/after macro has run
    Dim slidecount As Integer
    Dim t As Table
    Dim TOCrow As Integer
    Dim pptpres As Presentation
    
    Set pptpres = ActivePresentation
    slidecount = pptpres.Slides.Count
    If slidecount < 3 Then Exit Sub                                                ' nothing to do

    Set t = pptpres.Slides(2).Shapes(1).Table                                  ' grab= ther toc

    TOCrow = 2
    For i = 3 To slidecount Step 1                                                  ' get slide references for each slide
        If TOCrow > t.Rows.Count Then t.Rows.Add                         ' add rows on fly as needed

        ' create text entry in cell, then add hyperlink (doing in one step fails)

        With t.Cell(TOCrow, 1).Shape.TextFrame.TextRange
                .Text = pptpres.Slides(i).Shapes.Title.TextFrame.TextRange.Characters
        End With
        With t.Cell(TOCrow, 1).Shape.TextFrame.TextRange.Characters().ActionSettings(ppMouseClick).Hyperlink
                .Address = ""
                .SubAddress = pptpres.Slides(i).SlideNumber & ". " & pptpres.Slides(i).Name
        End With
        t.Cell(TOCrow, 2).Shape.TextFrame.TextRange.Text = i
    TOCrow = TOCrow + 1
    Next

End Sub


ex [enter image description here][1]


  [1]: https://i.stack.imgur.com/gaMJK.png

使用VBA在PowerPoint表格单元格中插入超链接

2 个答案: