リンクされた画像にハイパーリンクを追加する

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