將多個超鏈接添加到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的文本，然後創建超鏈接。