excel - 将超链接存储到 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