为链接的图像添加超链接

Question

我正在尝试为图像添加超链接，这些图像是通过 IncludePicture 字段添加的。

例如，这是一张图片：

{ IncludePicture "C:\Test\Image 1.png" \d }

因此，应该为其添加超链接：

C:\Test\Image 1.png

之后，我可以用鼠标在文档中点击我的图片，它会在文件管理器中打开。

这是代码。由于某种原因，它不能正常工作。应该如何修复？

Sub AddHyperlinksToImages()
    On Error Resume Next
    Application.ScreenUpdating = False
    Dim iShp As InlineShape
    For Each iShp In ActiveDocument.InlineShapes
        iShp.Hyperlink.Address = iShp.LinkFormat.SourceFullName 'Doesn't work

        'Just for testing
        'fullPath = iShp.LinkFormat.SourceFullName
        'MsgBox fullPath
    Next
    Application.ScreenUpdating = True
End Sub

Answer 1

请尝试此代码。

Sub AddHyperlinksToImages()
    ' 22 Sep 2017

    Dim Fld As Field
    Dim FilePath As String
    Dim Tmp As String
    Dim i As Integer

    Application.ScreenUpdating = False
    ActiveDocument.Fields.Update
    For Each Fld In ActiveDocument.Fields
        With Fld
            If InStr(1, Trim(.Code), "includepicture", vbTextCompare) = 1 Then
                If .InlineShape.Hyperlink Is Nothing Then
                    i = InStr(.Code, Chr(34))
                    If i Then
                        FilePath = Replace(Mid(.Code, i + 1), "\", "\")
                        i = InStr(FilePath, "\*")
                        If i Then FilePath = Left(FilePath, i - 1)
                        Do While Len(FilePath) > 1
                            i = Asc(Right(FilePath, 1))
                            FilePath = Left(FilePath, Len(FilePath) - 1)
                            If i = 34 Then Exit Do
                        Loop
                        If i > 1 Then ActiveDocument.Hyperlinks.Add .InlineShape, FilePath
                    End If
                End If
            End If
        End With
    Next Fld
    Application.ScreenUpdating = True
End Sub

为链接的图像添加超链接

Add hyperlinks to linked images

vba

ms-word

ms-office