링크 된 이미지에 하이퍼 링크 추가

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