向 PowerPoint 形状添加多个超链接

Question

任务：我有一个 PowerPoint 文件，其中包含带有文本的幻灯片。文本包含代码字，我想用超链接替换。现在我正在使用下面的代码来实现这一点。

For Each sld In prt.Slides
  For Each shp In sld.Shapes
    If shp.HasTextFrame Then
      If shp.TextFrame.HasText Then

        Set rngToSearch = shp.TextFrame.TextRange
        Set rngFound = rngToSearch.Find("SomeLink")

        Do While Not (rngFound Is Nothing)
            With rngFound

                With .ActionSettings(ppMouseClick)
                    .Action = ppActionHyperlink
                    .Hyperlink.Address = "http://www.SomeLink.de"
                    .Hyperlink.TextToDisplay = "SomeLink"
                End With

                .Font.Bold = msoFalse

                Set rngFound = rngToSearch.Find("SomeLink", .Start + .Length - 1)

            End With
        Loop

      End If
    End If
  Next shp
Next sld

工作原理： 代码设法找到代码字 SomeLink 的所有出现，并将这个词的每一个出现都加粗（我只是为了测试目的而这样做） .这告诉我，变量 rngFound 工作正常（即设置为每个 TextFrame 文本的正确子部分。

什么不起作用：代码不会为形状中的每个代码字创建超链接，而是只获取找到代码字的每个形状的第一个单词并创建超链接。下面的图片显示了之前和之后，以使这一点更清楚。

之前：

之后：

问题：有人知道如何让这段代码按预期运行吗？我现在真的吓坏了。

Answer 1

解决了，但我认为这很有趣，所以我不会只删除问题，而是实际给出答案。所以下面的代码就成功了。

For Each sld In prt.Slides
  For Each shp In sld.Shapes
    If shp.HasTextFrame Then
      If shp.TextFrame.HasText Then

        Set rngToSearch = shp.TextFrame.TextRange
        Set rngFound = rngToSearch.Find("SomeLink")

        Do While Not (rngFound Is Nothing)
            With rngFound

                rngFound.Text = "SomeLink"

                With .ActionSettings(ppMouseClick)
                    .Action = ppActionHyperlink
                    .Hyperlink.Address = "http://www.SomeLink.de"
                End With

                Set rngFound = rngToSearch.Find("SomeLink", .Start + .Length - 1)

            End With
        Loop

      End If
    End If
  Next shp
Next sld

我改变了什么？嗯，基本上只有两条线！我的错误是.Hyperlink.TextToDisplay = "SomeLink" 行。这不知何故弄乱了Textrange。相反，我现在首先使用新行 rngFound.Text = "SomeLink" 更改找到的 Textrange 的文本，然后创建超链接。