Как вставить несколько подписей и гиперссылок для нескольких изображений, присутствующих в слове?Например, «Рисунок: 1» под изображением и его гиперссылкой

Question

Я могу добавить несколько изображений в текстовый документ, используя VBA, но я не могу добавить подписи и гиперссылки для нескольких изображений, загруженных из пути к папке.Можете ли вы предложить по этому поводу:

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

Answer 1

Следующий код обеспечивает это:
- вставьте текст «Таблица рисунков:» в начале документа
- добавьте таблицу рисунков
- добавьте каждое изображение в свой каталог (включая егоимя в виде подписи ниже и разрыв страницы)
- обновить таблицу цифр

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

Если вы добавите ссылку на Microsoft Word x.x Object Library, вы можете использовать раннее связывание.Это означает, что вы можете использовать понятные значения ENUM, которые я отметил как комментарии.

Изображения сохраняются в виде ссылок в документе, так как документ может стать очень большим, если вы сохраните их полностью (см. AddPicture ).