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

添加链接图像的超链接

1 个答案: