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

将超链接存储到powerpoint的动态范围？

1 个答案: