從powerpoint存儲超鏈接到動態範圍？

Question

所以我有我使用下面的代碼演示文稿中修改所有超鏈接的一部分，一個大的PowerPoint演示文稿（刪除該文件路徑的一部分用相對的而不是絕對的引用）：

Dim oSl As Slide 
Dim oHl As Hyperlink 
Dim sSearchFor As String 
Dim sReplaceWith As String 
Dim oSh As Shape 

sSearchFor = InputBox("What text should I search for?", "Search for ...") 
If sSearchFor = "" Then 
    Exit Sub 
End If 

sReplaceWith = InputBox("What text should I replace" & vbCrLf _ 
    & sSearchFor & vbCrLf _ 
    & "with?", "Replace with ...") 
'If sReplaceWith = "" Then 
' Exit Sub 
'End If 

On Error Resume Next 

For Each oSl In ActivePresentation.Slides 

    For Each oHl In oSl.Hyperlinks 
     oHl.Address = Replace(oHl.Address, sSearchFor, sReplaceWith) 
     oHl.SubAddress = Replace(oHl.SubAddress, sSearchFor, sReplaceWith) 
    Next ' hyperlink 

    For Each oSh In oSl.Shapes 
     If oSh.Type = msoLinkedOLEObject _ 
     Or oSh.Type = msoMedia Then 
      oSh.LinkFormat.SourceFullName = _ 
       Replace(oSh.LinkFormat.SourceFullName, _ 
       sSearchFor, sReplaceWith) 
     End If 
    Next 

Next ' slide 

我想要做的QA這是顯示原始超鏈接和修改後的超鏈接在一張Excel表中比較原來的和新的鏈接，以確保一切工作正常。

我的第一篇文章，我試過谷歌，但沒有太多的喜悅，任何幫助非常感謝！

感謝

詹姆斯

Answer 1

像這樣的事情可以工作，但您需要添加Microsoft Excel引用

Dim oSl As Slide 
Dim oHl As Hyperlink 
Dim sSearchFor As String 
Dim sReplaceWith As String 
Dim oSh As Shape 
Dim wk As Workbook 
Dim ws As Worksheet 
Dim i As Double 

Set wk = Workbooks.Add 
Set ws = wk.Worksheets(1) 

ws.Cells(1, 1).Value = "original" 
ws.Cells(1, 2).Value = "modified" 
i = 2 

sSearchFor = InputBox("What text should I search for?", "Search for ...") 
If sSearchFor = "" Then 
    Exit Sub 
End If 

sReplaceWith = InputBox("What text should I replace" & vbCrLf _ 
    & sSearchFor & vbCrLf _ 
    & "with?", "Replace with ...") 
'If sReplaceWith = "" Then 
' Exit Sub 
'End If 

On Error Resume Next 

For Each oSl In ActivePresentation.Slides 

    For Each oHl In oSl.Hyperlinks 
     ws.Cells(i, 1).Value = oH1.Address 'original 
     oHl.Address = Replace(oHl.Address, sSearchFor, sReplaceWith) 'modification 
     ws.Cells(i, 2).Value = oH1.Address 'modified 
     i = i + 1 
     oHl.SubAddress = Replace(oHl.SubAddress, sSearchFor, sReplaceWith) 
    Next ' hyperlink 

    For Each oSh In oSl.Shapes 
     If oSh.Type = msoLinkedOLEObject _ 
     Or oSh.Type = msoMedia Then 
      oSh.LinkFormat.SourceFullName = _ 
       Replace(oSh.LinkFormat.SourceFullName, _ 
       sSearchFor, sReplaceWith) 
     End If 
    Next 

Next ' slide