Word VBA 在 Access 模板文档中的书签位置插入多个图像和标题

Question

我有一个 Word 模板，我使用 VBA 从 Access 数据库记录集填充该模板。我已为模板中的所有相关位置添加了书签，并使用 .SaveAs 命令循环遍历记录集，以使用每条记录的数据创建一个新的 Word 文档；然后重新填充下一条记录的模板。这对于文本来说效果很好。

我现在的挑战是将图像和文本描述（图像数量可变）添加到带有书签的位置的单词模板中。我从第一个记录集循环中查询了第二个记录集，该循环具有图像位置的完整文件路径以及该记录的图像描述。我想在图片下方添加描述。

对于文本，我使用以下内容，改编自 wordmvp.com

Private Sub btn_ExportWord_Click()

    Dim wApp As Word.Application
    Dim wDoc As Word.Document
    Dim rs As DAO.Recordset
    Dim BMRange As Range
    Dim filepath2 as String
    Dim strQuery as String

    'There is more included above here to define the file path and query but those are working just fine
    Set wApp = New Word.Application
    Set wDoc = wApp.Documents.Open(filepath2)

    Set rs = CurrentDb.OpenRecordset(strQuery)

    If Not rs.EOF Then rs.MoveFirst
    
    Do Until rs.EOF

    'There are 44 bookmarks so only subset included here
    Set BMRange = wDoc.Bookmarks("OtherNotesComments").Range
    BMRange.Text = Nz(rs!OtherNotesComments, "")
    wDoc.Bookmarks.Add "OtherNotesComments", BMRange
    Set BMRange = Nothing
    Set BMRange = wDoc.Bookmarks("OtherNotesComments").Range
    BMRange.Text = Nz(rs!OtherNotesComments, "")
    wDoc.Bookmarks.Add "OtherNotesComments", BMRange
    Set BMRange = Nothing

    wDoc.SaveAs2 filepath & "\" & ReportType2 & rs!PFM_Number & ".docx"

    rs.MoveNext

    Loop

End Sub

我已使用以下命令插入在.SaveAs之前成功添加的所有图像；添加新变量所需的维度。

If Not rs2.EOF Then rs2.MoveFirst

Do Until rs2.EOF

Set BMImage = wDoc.Bookmarks("PFM_Images").Range
BMImage.InlineShapes.AddPicture FileName:=rs2!FullPath, LinkToFile:=False, SaveWithDocument:=True
wDoc.Bookmarks.Add "PFM_Images", BMImage
Set BMImage = Nothing


rs2.MoveNext

wDoc.SaveAs2 filepath & "\" & ReportType2 & rs!PFM_Number & ".docx"

rs.MoveNext

Loop

我似乎不知道如何将描述添加到图像中。我尝试使用 InsertCaption 方法，但在尝试将其与 BMIMage 范围一起使用时出现错误。任何帮助将不胜感激。

Answer 1

• 这里有一个

  Word VBA

  代码来展示如何插入图像和标题

Option Explicit
Sub InsertImageAndCaption()
    Dim bookmarkName As String
    Dim imagePath As String
    Dim captionText As String
    Dim rng As Range
    Dim img As InlineShape
    ' modify as needed
    bookmarkName = "PFM_Images"
    imagePath = "d:\temp\2.png"
    captionText = "MyFirstImage"
    ' ***
    ' Check if the bookmark exists
    If ActiveDocument.Bookmarks.Exists(bookmarkName) Then
        ' Set the range to the bookmark
        Set rng = ActiveDocument.Bookmarks(bookmarkName).Range
        ' Insert the picture at the bookmark location
        rng.Text = ""
        Set img = rng.InlineShapes.AddPicture(FileName:=imagePath, LinkToFile:=False, SaveWithDocument:=True)
        rng.MoveEnd 4, 1 ' Word.wdParagraph = 4
        ' Insert a caption after the picture
        rng.InsertCaption Label:="Figure", Title:=vbTab & captionText, Position:=wdCaptionPositionBelow
    Else
        MsgBox "Bookmark '" & bookmarkName & "' not found in the document.", vbCritical
    End If
End Sub