Word VBA вставляет несколько изображений и подписей в место, отмеченное закладкой, в документе шаблона из Access
У меня есть шаблон слова, который я заполняю из набора записей базы данных Access с помощью VBA. Я добавил в закладки все соответствующие места в шаблоне и просмотрел набор записей с помощью команды .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. Любая помощь будет оценена по достоинству.
Ответы 2
- Вот фрагмент
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)
' recreate bookmark
With ActiveDocument.Bookmarks
.Add Range:=img.Range, Name:=bookmarkName
.ShowHidden = False
End With
' Insert a caption after the picture
img.Range.InsertCaption Label: = "Figure", Title:=vbTab & captionText, Position:=wdCaptionPositionBelow
Else
MsgBox "Bookmark '" & bookmarkName & "' not found in the document.", vbCritical
End If
End Sub
It appears that the above removes the image bookmark - Вы можете keep создать закладку (фактически она будет создана заново), если считаете, что она полезна для следующего этапа обработки. Или используйте For Each Shp in ActiveDocument.InlineShapes для перебора изображений.
Отлично, спасибо, не могли бы вы рассказать, как воссоздать закладку после вставленного изображения и подписи?
Я обновил код.
Так близко, что когда я просматриваю набор записей изображений, все подписи добавляются, но включается только последнее изображение. Похоже, что для первого цикла добавляется изображение и подпись, но для каждого последующего цикла заменяется изображение, а затем добавляется подпись. Есть предположения? Еще раз спасибо за вашу помощь.
Кажется, ваш скрипт помещает изображения в одно и то же место закладки. Как я упоминал в своем предыдущем комментарии, закладка воссоздается при каждой вставке изображения. Следовательно, следующее изображение заменяет предыдущее в том же месте, в результате чего первое изображение исчезает. Вот почему вы видите только последнее изображение. Возможно, вам придется рассмотреть другой метод организации изображений в документе.
Вот что в итоге сработало; на самом деле два решения. Первый помещает описание изображения в виде обычного текста под изображением, а второй использует метод InsertCaption. Метод Insertcaption создает некоторые странные проблемы с разрывом страницы, которые еще предстоит решить, но он позволяет включить описание в качестве заголовка.
Первое решение использует bookmarks("name").select для размещения выделения в закладке, в данном случае в закладке-заполнителе. Затем использует метод with word_application.selection для вставки изображения, возврата каретки, описания, еще одного возврата каретки, а затем сворачивается до конца, переходит к следующей записи и зацикливается.
Set rs2 = CurrentDb.OpenRecordset(strQuery2)
If Not rs2.EOF Then
If Not rs2.EOF Then rs2.MoveFirst
wDoc.Bookmarks("PFM_IMages").Select
Do Until rs2.EOF
With wApp.Selection
.InlineShapes.AddPicture FileName:=rs2!FullPath, LinkToFile:=False, SaveWithDocument:=True
.InsertParagraphAfter
.InsertAfter Nz(rs2!Caption, "")
.InsertParagraphAfter
.Collapse wdCollapseEnd
End With
rs2.MoveNext
Loop
End If
wDoc.SaveAs2 filepath & "\" & ReportType2 & rs!PFM_Number & ".docx"
rs.MoveNext
Второе решение включает два цикла: первый аналогичен приведенному выше, но без размещения текста описания. Затем возвращается к первой записи в наборе записей, измеряя целочисленную переменную и переменную InlineShape, и снова проходит по набору записей от i = 1 до конца набора записей.
Set rs2 = CurrentDb.OpenRecordset(strQuery2)
If Not rs2.EOF Then
If Not rs2.EOF Then rs2.MoveFirst
wDoc.Bookmarks("PFM_IMages").Select
Do Until rs2.EOF
With wApp.Selection
.InlineShapes.AddPicture FileName:=rs2!FullPath, LinkToFile:=False, SaveWithDocument:=True
.InsertParagraphAfter
.Collapse wdCollapseEnd
End With
rs2.MoveNext
Loop
rs2.MoveFirst
i = 1
Do Until rs2.EOF
Set ImageIsh = wDoc.InlineShapes(i)
ImageIsh.Range.InsertCaption Label:=-1, Title:=rs2!Caption, Position:=1, ExcludeLabel:=False
i = i + 1
rs2.MoveNext
Loop
End If
wDoc.SaveAs2 filepath & "\" & ReportType2 & rs!PFM_Number & ".docx"
rs.MoveNext
Спасибо, выше, я ценю нюанс установки переменной диапазона в диапазон закладок, а затем использования ее для установки переменной InlineShape. Похоже, что вышеизложенное удаляет закладку изображения, поэтому мне неясно, как мне затем перебирать изображения, поскольку закладка больше не доступна при последующих проходах цикла. Любой совет, который вы можете дать, ценится. Спасибо