VBA 将多个超链接添加到一个 Powerpoint 文本框

VBA to add multiple hyperlinks to one Powerpoint text box

我在 Powerpoint 中使用 VBA 循环从 Excel 导入数据,并将导入的每个新字符串作为新项目符号写入幻灯片的文本框中。这很好用。然后应将同样导入的超链接添加到每个项目符号中。这有效,除了只有最后一个项目符号保留其超链接。我怀疑超链接不是专门添加到项目符号而是添加到文本框,因此被每个新项目符号覆盖,只留下带有超链接的底部项目符号。知道如何保留所有项目符号的超链接吗?

非常感谢!

new_slide.Shapes(2).TextFrame.TextRange.text = new_slide.Shapes(2).TextFrame.TextRange.text & vbNewLine & new_text

With new_slide.Shapes(2).TextFrame.TextRange.Find(new_text).ActionSettings(ppMouseClick)
    .Action = ppActionHyperlink
    .Hyperlink.Address = excel_link
End With

{修改后的版本}

如果我们先添加文本,然后遍历每一行,一次添加一行超链接,效果会很好。您需要通过 XL 导入两次,一次用于文本,一次用于超链接:

Sub RoundTwo()
    Dim oSh As Shape
    Dim x As Long
    
    Set oSh = ActiveWindow.Selection.ShapeRange(1)
    
    For x = 1 To 3
        With oSh.TextFrame.TextRange
            .Text = .Text & vbNewLine & "Some new text"
        End With
    Next
    
    For x = 1 To 3
        Call AddLinkToLine(oSh, x)
    Next
    
End Sub

Sub AddLinkToLine(oSh As Shape, lLine As Long)
    With oSh.TextFrame.TextRange.Paragraphs(lLine)
        With .ActionSettings(ppMouseClick)
            .Action = ppActionHyperlink
            .Hyperlink.Address = "http://www.pptfaq.com"
        End With
    End With
End Sub