Question

这是一个宏，它允许替换图像中的超链接。

（如何使用它：将一些图像复制到文档，然后为每个图像添加超链接，例如www.google.com，然后，使用此宏，您可以将这些超链接替换为不同的图像，例如www.stackoverflow.com。上传的测试文件：https://ufile.io/qbdcp）。

起初，我尝试使用

If .Type = msoHyperlinkInlineShape

但出于某种原因，它不适用于从文件管理器复制的内嵌图像（文件管理器中的Ctrl-C，Word中的Ctrl-V）。

然后，我将其替换为

If .Type = msoHyperlinkShape

现在可行。

但我仍然想知道为什么我被迫将msoHyperlinkInlineShape更改为msoHyperlinkShape，而我使用内嵌图片。为什么msoHyperlinkInlineShape不起作用？

Sub ReplaceHyperlinks()
    Dim HL As Hyperlink
    Dim sFind As String
    Dim sRepl As String
    Dim iCnt As Integer

    sFind = InputBox("Find what", "Find Hyperlink")
    If Len(sFind) = 0 Then Exit Sub
    sRepl = InputBox("Replace with", "Replace Hyperlink")
    If Len(sRepl) = 0 Then Exit Sub
    iCnt = 0
    For Each HL In ActiveDocument.Hyperlinks
        With HL

            If .Type = msoHyperlinkShape Then ' msoHyperlinkInlineShape will not work for some reason

                If InStr(LCase(.Address), LCase(sFind)) Then
                    .Address = Replace(.Address, sFind, sRepl, , , vbTextCompare)
                    .ScreenTip = Replace(.ScreenTip, sFind, sRepl, , , vbTextCompare)
                    On Error Resume Next
                    .Range.Fields.Update
                    iCnt = iCnt + 1
                End If
                If InStr(LCase(.TextToDisplay), LCase(sFind)) Then
                    .TextToDisplay = Replace(.TextToDisplay, sFind, sRepl, , , vbTextCompare)
                    .Range.Fields.Update
                End If
            End If
        End With
    Next
    MsgBox ("Links replaced: " & iCnt)
End Sub

msoHyperlinkInlineShape不适用于内嵌图像

0 个答案: