将多个超链接添加到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的文本，然后创建超链接。