How to insert multiple captions and hyperlinks for multiple images present in word? For example “Figure:1” below image and its hyperlink

Question

I am able to add multiple images to a word document using VBA, but I am not able to add captions and its hyperlinks for multiple images loaded from the folder path. Can you please suggest on this:

Sub checking()
    Dim strFolderPath
    strFolderPath = "C:\images"
    Dim objWord
    Dim objDoc
    Dim objSelection
    Dim objShapes
    Dim objFSO
    Dim objFolder

    Set objWord = CreateObject("Word.Application")
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    Set objFolder = objFSO.GetFolder(strFolderPath)
    Set objDoc = objWord.Documents.Open("D:\myfile.docx")

    objWord.Visible = True

    Set objSelection = objWord.Selection

    For Each Img In objFolder.Files
        ImgPath = Img.Path
        objSelection.InlineShapes.AddPicture (ImgPath)
        objSelection.InsertBreak
    Next
End Sub

This is not a duplicate, even if I showed @srihari here stackoverflow.com/q/54779261/10908769, how to insert the file name below each picture (as wanted!). As srihari now wants it usable for a TOC, I suggested a new question. So here we are ... — Asger
I need to insert all the labels as table of contents which can be accessed and I have edited the same question. — srihari
@PEH the approach explained stackoverflow.com/q/54779261/10908769 doesn't disaplay labels as table of contents. — srihari

Asger Asger · Accepted Answer · 2019-02-20T20:35:48

Following code provides this:
- insert a text "Table of Figures:" at the beginning of the document
- add a table of figures
- add each picture pof your directory (incl. its name as caption below and a page break)
- update the table of figures

Sub InsertPicturesAndTheirNames()
    Dim objWord As Object   ' Word.Application
    Dim objDoc As Object    ' Word.Document
    Dim objShape As Object  ' Word.InlineShape
    Dim objTOF As Object    ' Word.TableOfFigures
    Dim objFSO As Object    ' Scripting.FileSystemObject
    Dim strFolderPath As String
    Dim objFolder As Object ' Scripting.Folder
    Dim imgpath As String
    Dim img As Object       ' Scripting.File

    strFolderPath = "C:\images"

    On Error Resume Next
    If objWord Is Nothing Then
        Set objWord = GetObject(, "Word.Application")
        If objWord Is Nothing Then
            Set objWord = CreateObject("Word.Application")
        End If
    End If
    On Error GoTo 0
    objWord.Visible = True

    Set objDoc = objWord.Documents.Open("D:\myfile.docx")

    objDoc.Bookmarks("\StartOfDoc").Select
    objWord.Selection.Text = "Table of Figures:"
    objWord.Selection.InsertParagraphAfter
    objWord.Selection.Collapse 0    ' 0 = wdCollapseEnd

    objDoc.TablesOfFigures.Format = 5 ' 5 = wdTOFSimple
    Set objTOF = objDoc.TablesOfFigures.Add( _
        Range:=objWord.Selection.Range, _
        Caption:=-1, _
        IncludeLabel:=True, _
        RightAlignPageNumbers:=True, _
        UseHeadingStyles:=False, _
        UpperHeadingLevel:=1, _
        LowerHeadingLevel:=3, _
        IncludePageNumbers:=True, _
        AddedStyles:="", _
        UseHyperlinks:=True, _
        HidePageNumbersInWeb:=True) ' -1 = wdCaptionFigure
    objTOF.TabLeader = 1 ' 1 = wdTabLeaderDots
    objTOF.Range.InsertParagraphAfter
    objTOF.Range.Next(Unit:=4, Count:=1).InsertBreak Type:=7 ' 4 = wdParagraph, 7 = wdPageBreak

    objDoc.Bookmarks("\EndOfDoc").Select

    Set objFSO = CreateObject("Scripting.FileSystemObject")
    Set objFolder = objFSO.GetFolder(strFolderPath)
    For Each img In objFolder.Files
        imgpath = img.Path
        Set objShape = objDoc.InlineShapes.AddPicture( _
            Filename:=imgpath, _
            LinkToFile:=True, _
            SaveWithDocument:=False)
        objShape.Range.InsertCaption _
                Label:=-1, _
                TitleAutoText:="", _
                Title:=": " & Mid(imgpath, InStrRev(imgpath, "\") + 1), _
                Position:=1, _
                ExcludeLabel:=False ' -1 = wdCaptionFigure, 1 = wdCaptionPositionBelow
        objDoc.Bookmarks("\EndOfDoc").Select
        objWord.Selection.InsertParagraphAfter
        objDoc.Bookmarks("\EndOfDoc").Select
        objWord.Selection.InsertBreak Type:=7 ' 7 = wdPageBreak
    Next

    objTOF.Update
End Sub

If you add a reference to Microsoft Word x.x Object Library you can use early binding. That means you could use the self-explanatory ENUM values I noted as comments.

The pictures are stored as links in the document, as the document my get very large if you store them completely (refer to AddPicture).

How to insert multiple captions and hyperlinks for multiple images present in word? For example “Figure:1” below image and its hyperlink

1 Answers