Создание документов Word (в Excel VBA) из серии шаблонов документов

Всем привет. Я постараюсь сделать это кратким и простым. 🙂

у меня есть

  1. 40 или около того, чтобы печатать текстовые документы с рядом полей (Имя, адрес и т. Д.), Которые необходимо заполнить. Это исторически сделано вручную, но оно повторяется и громоздко.
  2. Книга, в которой пользователь заполнил огромный набор информации о человеке.

мне нужно

  • Способ программирования (из Excel VBA) открывает эти шаблонные документы, редактирует значение полей из разных именованных диапазонов в рабочей книге и сохраняет заполненные шаблоны в локальной папке.

Если бы я использовал VBA для программного редактирования определенных значений в наборе электронных таблиц, я бы отредактировал все эти электронные таблицы, чтобы они содержали набор именованных диапазонов, которые можно было использовать в процессе автозаполнения, но я не знаю ни одного имени поле “в документе Word.

Как я могу редактировать документы и создавать процедуру VBA, чтобы я мог открыть каждый документ, найти набор полей, которые могут потребоваться заполнить, и заменить значение?

Например, что-то, что работает:

for each document in set_of_templates if document.FieldExists("Name") then document.Field("Name").value = strName if document.FieldExists("Address") then document.Field("Name").value = strAddress ... document.saveAs( thisWorkbook.Path & "\GeneratedDocs\ " & document.Name ) next document 

Вещи, которые я рассмотрел:

  • Слияние почты – но этого недостаточно, потому что он требует открытия каждого документа вручную и структурирования книги в качестве источника данных, я вроде как хочу обратное. Шаблоны являются источником данных, и рабочая тетрадь выполняет итерацию через них. Кроме того, слияние почты предназначено для создания множества идентичных документов с использованием таблицы разных данных. У меня много документов, которые используют одни и те же данные.
  • Использование текста заполнителя, например «# NAME #», и открытия каждого документа для поиска и замены. Это решение, к которому я бы прибегнул, если не предлагается ничего более элегантного.

Прошло много времени с тех пор, как я задал этот вопрос, и мое решение претерпело все новые и новые усовершенствования. Мне приходилось иметь дело со всякими особыми случаями, такими как значения, которые поступают непосредственно из рабочей книги, разделы, которые должны быть специально созданы на основе списков, и необходимость выполнять замены в верхних и нижних колонтитулах.

Как оказалось, недостаточно было использовать закладки, так как пользователям было возможно впоследствии редактировать документы для изменения, добавления и удаления значений-заполнителей из документов. На самом деле решение заключалось в использовании таких ключевых слов , как:

введите описание изображения здесь

Это всего лишь страница из образца документа, который использует некоторые из возможных значений, которые могут автоматически вставляться в документ. Более 50 документов существуют с совершенно разными структурами и макетами и с использованием разных параметров. Единственное общее знание, которое разделяют словарные документы и электронная таблица excel, – это знание того, что означают эти значения-заполнители. В excel это сохраняется в списке ключевых слов генерации документа, которые содержат ключевое слово, а затем ссылка на диапазон, который фактически содержит это значение:

введите описание изображения здесь

Это были ключевые два необходимых ингредиента. Теперь с некоторым умным кодом все, что мне нужно было сделать, это перебрать каждый создаваемый документ, а затем перебрать диапазон всех известных ключевых слов и выполнить поиск и замену для каждого ключевого слова в каждом документе.


Во-первых, у меня есть метод обертки, который заботится о том, чтобы поддерживать экземпляр слова microsoft, выполняющего итерацию по всем документам, выбранным для генерации, нумерации документов и выполнению материалов пользовательского интерфейса (таких как обработка ошибок, отображение папки пользователю и т. Д. )

 ' Purpose: Iterates over and generates all documents in the list of forms to generate ' Improves speed by creating a persistant Word application used for all generated documents Public Sub GeneratePolicy() Dim oWrd As New Word.Application Dim srcPath As String Dim cel As Range If ERROR_HANDLING Then On Error GoTo errmsg If Forms.Cells(2, FormsToGenerateCol) = vbNullString Then _ Err.Raise 1, , "There are no forms selected for document generation." 'Get the path of the document repository where the forms will be found. srcPath = FindConstant("Document Repository") 'Each form generated will be numbered sequentially by calling a static counter function. This resets it. GetNextEndorsementNumber reset:=True 'Iterate over each form, calling a function to replace the keywords and save a copy to the output folder For Each cel In Forms.Range(Forms.Cells(2, FormsToGenerateCol), Forms.Cells(1, FormsToGenerateCol).End(xlDown)) RunReplacements cel.value, CreateDocGenPath(cel.Offset(0, 1).value), oWrd Next cel oWrd.Quit On Error Resume Next 'Display the folder containing the generated documents Call Shell("explorer.exe " & CreateDocGenPath, vbNormalFocus) oWrd.Quit False Application.StatusBar = False If MsgBox("Policy generation complete. The reserving information will now be recorded.", vbOKCancel, _ "Policy Generated. OK to store reserving info?") = vbOK Then Push_Reserving_Requirements Exit Sub errmsg: MsgBox Err.Description, , "Error generating Policy Documents" End Sub 

Эта процедура вызывает RunReplacements которая заботится об открытии документа, подготовке среды для быстрой замены, обновлении ссылок после выполнения, обработке ошибок и т. Д .:

 ' Purpose: Opens up a document and replaces all instances of special keywords with their respective values. ' Creates an instance of Word if an existing one is not passed as a parameter. ' Saves a document to the target path once the template has been filled in. ' ' Replacements are done using two helper functions, one for doing simple keyword replacements, ' and one for the more complex replacements like conditional statements and schedules. Private Sub RunReplacements(ByVal DocumentPath As String, ByVal SaveAsPath As String, _ Optional ByRef oWrd As Word.Application = Nothing) Dim oDoc As Word.Document Dim oWrdGiven As Boolean If oWrd Is Nothing Then Set oWrd = New Word.Application Else oWrdGiven = True If ERROR_HANDLING Then On Error GoTo docGenError oWrd.Visible = False oWrd.DisplayAlerts = wdAlertsNone Application.StatusBar = "Opening " & Mid(DocumentPath, InStrRev(DocumentPath, "\") + 1) Set oDoc = oWrd.Documents.Open(Filename:=DocumentPath, Visible:=False) RunAdvancedReplacements oDoc RunSimpleReplacements oDoc UpdateLinks oDoc 'Routine which will update calculated statements in Word (like current date) Application.StatusBar = "Saving " & Mid(DocumentPath, InStrRev(DocumentPath, "\") + 1) oDoc.SaveAs SaveAsPath GoTo Finally docGenError: MsgBox "Un unknown error occurred while generating document: " & DocumentPath & vbNewLine _ & vbNewLine & Err.Description, vbCritical, "Document Generation" Finally: If Not oDoc Is Nothing Then oDoc.Close False: Set oDoc = Nothing If Not oWrdGiven Then oWrd.Quit False End Sub 

Затем эта процедура вызывает RunSimpleReplacements . и RunAdvancedReplacements . В первом мы перебираем набор ключевых слов генерации документов и вызываем WordDocReplace если документ содержит наше ключевое слово. Обратите внимание, что гораздо быстрее попробовать и Find кучу слов, чтобы понять, что их не существует, а затем вызвать замену без parsingа, поэтому мы всегда проверяем, существует ли ключевое слово, прежде чем пытаться его заменить.

 ' Purpose: While short, this short module does most of the work with the help of the generation keywords ' range on the lists sheet. It loops through every simple keyword that might appear in a document ' and calls a function to have it replaced with the corresponding data from pricing. Private Sub RunSimpleReplacements(ByRef oDoc As Word.Document) Dim DocGenKeys As Range, valueSrc As Range Dim value As String Dim i As Integer Set DocGenKeys = Lists.Range("DocumentGenerationKeywords") For i = 1 To DocGenKeys.Rows.Count If WordDocContains(oDoc, "#" & DocGenKeys.Cells(i, 1).Text & "#") Then 'Find the text that we will be replacing the placeholder keyword with Set valueSrc = Range(Mid(DocGenKeys.Cells(i, 2).Formula, 2)) If valueSrc.MergeCells Then value = valueSrc.MergeArea.Cells(1, 1).Text Else value = valueSrc.Text 'Perform the replacement WordDocReplace oDoc, "#" & DocGenKeys.Cells(i, 1).Text & "#", value End If Next i End Sub 

Это функция, используемая для определения наличия ключевого слова в документе:

 ' Purpose: Function called for each replacement to first determine as quickly as possible whether ' the document contains the keyword, and thus whether replacement actions must be taken. Public Function WordDocContains(ByRef oDoc As Word.Document, ByVal searchFor As String) As Boolean Application.StatusBar = "Checking for keyword: " & searchFor WordDocContains = False Dim storyRange As Word.Range For Each storyRange In oDoc.StoryRanges With storyRange.Find .Text = searchFor WordDocContains = WordDocContains Or .Execute End With If WordDocContains Then Exit For Next End Function 

И именно здесь резина встречает дорогу – код, который выполняет замену. Эта процедура усложнилась, когда я столкнулся с трудностями. Вот уроки, которые вы сможете извлечь из опыта:

  1. Вы можете напрямую установить заменяющий текст, или вы можете использовать буфер обмена. Я обнаружил, что, если вы используете замену VBA в словах длиной более 255 символов, текст будет усечен, если вы попытаетесь поместить его в Find.Replacement.Text , но вы можете использовать "^c" как ваш заменяющий текст, и он получит его непосредственно из буфера обмена. Это был обходной путь, который мне пришлось использовать.

  2. Простое замещение заменяет ключевые слова в некоторых текстовых областях, таких как верхние и нижние колонтитулы. Из-за этого вам действительно нужно перебирать document.StoryRanges и запускать поиск и замену на каждом из них, чтобы убедиться, что вы улавливаете все экземпляры слова, которое хотите заменить.

  3. Если вы напрямую устанавливаете Replacement.Text , вам нужно преобразовать разрывы строк Excel ( vbNewLine и Chr(10) ) с простым vbCr для правильного отображения слов. В противном случае в любом месте вашего текста замены есть разрывы строк, исходящие из ячейки excel, в результате чего вставляются странные символы в слово. Однако, если вы используете метод буфера обмена, вам не нужно это делать, так как разрывы строк автоматически преобразуются при вставке в буфер обмена.

Это все объясняет. Комментарии тоже должны быть понятны. Вот золотая рутина, которая выполняет магию:

 ' Purpose: This function actually performs replacements using the Microsoft Word API Public Sub WordDocReplace(ByRef oDoc As Word.Document, ByVal replaceMe As String, ByVal replaceWith As String) Dim clipBoard As New MSForms.DataObject Dim storyRange As Word.Range Dim tooLong As Boolean Application.StatusBar = "Replacing instances of keyword: " & replaceMe 'We want to use regular search and replace if we can. It's faster and preserves the formatting that 'the keyword being replaced held (like bold). If the string is longer than 255 chars though, the 'standard replace method doesn't work, and so we must use the clipboard method (^c special character), 'which does not preserve formatting. This is alright for schedules though, which are always plain text. If Len(replaceWith) > 255 Then tooLong = True If tooLong Then clipBoard.SetText IIf(replaceWith = vbNullString, "", replaceWith) clipBoard.PutInClipboard Else 'Convert excel in-cell line breaks to word line breaks. (Not necessary if using clipboard) replaceWith = Replace(replaceWith, vbNewLine, vbCr) replaceWith = Replace(replaceWith, Chr(10), vbCr) End If 'Replacement must be done on multiple 'StoryRanges'. Unfortunately, simply calling replace will miss 'keywords in some text areas like headers and footers. For Each storyRange In oDoc.StoryRanges Do With storyRange.Find .MatchWildcards = True .Text = replaceMe .Replacement.Text = IIf(tooLong, "^c", replaceWith) .Wrap = wdFindContinue .Execute Replace:=wdReplaceAll End With On Error Resume Next Set storyRange = storyRange.NextStoryRange On Error GoTo 0 Loop While Not storyRange Is Nothing Next If tooLong Then clipBoard.SetText "" If tooLong Then clipBoard.PutInClipboard End Sub 

Когда пыль оседает, мы остаемся с красивой версией исходного документа с производственными значениями вместо тех хеш-отмеченных ключевых слов. Я хотел бы показать пример, но, конечно, каждый заполненный документ содержит всю конфиденциальную информацию.


RunAdvancedReplacements только упомянуть, что я думаю, это будет раздел RunAdvancedReplacements . Он делает что-то очень похожее – он в конечном итоге вызывает ту же функцию WordDocReplace , но то, что особенно WordDocReplace в ключевых словах, используемых здесь, заключается в том, что они не ссылаются на одну ячейку в исходной книге, они генерируются в кодовом коде из списков в книги. Так, например, одна из передовых замен будет выглядеть так:

 'Generate the schedule of vessels If WordDocContains(oDoc, "#VESSELSCHEDULE#") Then _ WordDocReplace oDoc, "#VESSELSCHEDULE#", GenerateVesselSchedule() 

И тогда будет соответствующая процедура, которая объединяет строку, содержащую всю информацию о судне, как настроено пользователем:

 ' Purpose: Generates the list of vessels from the "Vessels" sheet based on the user's configuration ' in the booking tab. The user has the option to generate one or both of Owned Vessels ' and Chartered Vessels, as well as what fields to display. Uses a helper function. Public Function GenerateVesselSchedule() As String Dim value As String Application.StatusBar = "Generating Schedule of Vessels." If Booking.Range("ListVessels").value = "Yes" Then Dim VesselCount As Long If Booking.Range("ListVessels").Offset(1).value = "Yes" Then _ value = value & GenerateVesselScheduleHelper("Vessels", VesselCount) If Booking.Range("ListVessels").Offset(1).value = "Yes" And _ Booking.Range("ListVessels").Offset(2).value = "Yes" Then _ value = value & "(Chartered Vessels)" & vbNewLine If Booking.Range("ListVessels").Offset(2).value = "Yes" Then _ value = value & GenerateVesselScheduleHelper("CharteredVessels", VesselCount) If Len(value) > 2 Then value = Left(value, Len(value) - 2) 'Remove the trailing line break Else GenerateVesselSchedule = Booking.Range("VesselSchedAlternateText").Text End If GenerateVesselSchedule = value End Function ' Purpose: Helper function for the Vessel Schedule generation routine. Generates either the Owned or ' Chartered vessels based on the schedule parameter passed. The list is numbered and contains ' the information selected by the user on the Booking sheet. ' SENSITIVE: Note that this routine is sensitive to the layout of the Vessel Schedule tab and the ' parameters on the Configure Quotes tab. If either changes, it should be revisited. Public Function GenerateVesselScheduleHelper(ByVal schedule As String, ByRef VesselCount As Long) As String Dim value As String, nextline As String Dim numInfo As Long, iRow As Long, iCol As Long Dim Inclusions() As Boolean, Columns() As Long 'Gather info about vessel info to display in the schedule With Booking.Range("VesselInfoToInclude") numInfo = Booking.Range(.Cells(1, 1), .End(xlToRight)).Columns.Count - 1 ReDim Inclusions(1 To numInfo) ReDim Columns(1 To numInfo) On Error Resume Next 'Some columns won't be identified For iCol = 1 To numInfo Inclusions(iCol) = .Offset(0, iCol) = "Yes" Columns(iCol) = sumSchedVessels.Range(schedule).Cells(1).EntireRow.Find(.Offset(-1, iCol)).Column Next iCol On Error GoTo 0 End With 'Build the schedule With sumSchedVessels.Range(schedule) For iRow = .row + 1 To .row + .Rows.Count - 1 If Len(sumSchedVessels.Cells(iRow, Columns(1)).value) > 0 Then VesselCount = VesselCount + 1 value = value & VesselCount & "." & vbTab nextline = vbNullString 'Add each property that was included to the description string If Inclusions(1) Then nextline = nextline & sumSchedVessels.Cells(iRow, Columns(1)) & vbTab If Inclusions(2) Then nextline = nextline & "Built: " & sumSchedVessels.Cells(iRow, Columns(2)) & vbTab If Inclusions(3) Then nextline = nextline & "Length: " & _ Format(sumSchedVessels.Cells(iRow, Columns(3)), "#'") & vbTab If Inclusions(4) Then nextline = nextline & "" & sumSchedVessels.Cells(iRow, Columns(4)) & vbTab If Inclusions(5) Then nextline = nextline & "Hull Value: " & _ Format(sumSchedVessels.Cells(iRow, Columns(5)), "$#,##0") & vbTab If Inclusions(6) Then nextline = nextline & "IV: " & _ Format(sumSchedVessels.Cells(iRow, Columns(6)), "$#,##0") & vbTab If Inclusions(7) Then nextline = nextline & "TIV: " & _ Format(sumSchedVessels.Cells(iRow, Columns(7)), "$#,##0") & vbTab If Inclusions(8) And schedule = "CharteredVessels" Then _ nextline = nextline & "Deductible: " & Format(bmCharterers.Range(schedule).Cells( _ iRow - .row, 9), "$#,##0") & vbTab nextline = Left(nextline, Len(nextline) - 1) 'Remove the trailing tab 'If more than 4 properties were included insert a new line after the 4th one Dim tabloc As Long: tabloc = 0 Dim counter As Long: counter = 0 Do tabloc = tabloc + 1 tabloc = InStr(tabloc, nextline, vbTab) If tabloc > 0 Then counter = counter + 1 Loop While tabloc > 0 And counter < 4 If counter = 4 Then nextline = Left(nextline, tabloc - 1) & vbNewLine & Mid(nextline, tabloc) value = value & nextline & vbNewLine End If Next iRow End With GenerateVesselScheduleHelper = value End Function 

результирующая строка может использоваться так же, как содержимое любой ячейки excel, и передается функции замены, которая будет соответствующим образом использовать метод буфера обмена, если он превышает 255 символов.

Итак, этот шаблон:

введите описание изображения здесь

Кроме того, данные в электронной таблице:

введите описание изображения здесь

Стать этим документом:

введите описание изображения здесь


Я искренне надеюсь, что однажды это поможет кому-то. Это было определенно огромная задача и сложное колесо, которое нужно было изобретать. Приложение огромно, с более чем 50 000 строк кода VBA, поэтому, если я ссылаюсь на ключевой метод в моем коде где-то, что кому-то нужно, оставьте комментарий, и я добавлю его здесь.

http://www.computorcompanion.com/LPMArticle.asp?ID=224 Описывает использование закладок Word

Раздел текста в документе может быть помечен в закладки и задан имя переменной. Используя VBA, эту переменную можно получить, а содержимое в документе можно заменить альтернативным контентом. Это решение иметь в документе заполнители, такие как имя и адрес.

Кроме того, используя закладки, документы могут быть изменены для ссылки на закладки. Если имя появляется несколько раз в документе, первый экземпляр может быть помечен в закладки, а дополнительные экземпляры могут ссылаться на закладку. Теперь, когда первый экземпляр программно изменен, все остальные экземпляры переменной во всем документе также автоматически изменяются.

Теперь все, что необходимо, – это обновить все документы, поместив закладку в текст заполнителя и используя согласованное соглашение об именах в документах, а затем перебирайте каждый документ, заменяя закладку, если она существует:

 document.Bookmarks("myBookmark").Range.Text = "Inserted Text" 

Вероятно, я могу решить проблему переменных, которые не отображаются в данном документе, используя следующее предложение о возврате ошибки при попытке каждой замены.

Спасибо Дугу Глэнси за упоминание о существовании закладок в его комментарии. Я заранее не знал о их существовании. Я буду держать эту тему в курсе, достаточно ли этого решения.

Вы можете рассмотреть подход на основе XML.

У Word есть функция, называемая пользовательской привязкой данных XML, или контроль содержимого, связанный с данными. Управление содержимым – это, по сути, точка в документе, которая может содержать контент. Управление содержимым, связанное с данными, получает его содержимое из документа XML, который вы включаете в файл zoc docx. Выражение XPath используется, чтобы сказать, какой бит XML. Итак, все, что вам нужно сделать, это включить ваш XML-файл, и Word сделает все остальное.

У Excel есть способы получить данные из него как XML, поэтому все решение должно работать хорошо.

Существует много информации о привязке данных управления содержимым на MSDN (некоторые из которых упоминаются в предыдущих SO-вопросах), поэтому я не буду беспокоиться о включении их здесь.

Но вам нужен способ настройки привязок. Вы можете использовать Content Control Toolkit, или если хотите сделать это из Word, моей надстройкой OpenDoPE.

Проделав аналогичную задачу, я обнаружил, что вставка значений в таблицы была намного быстрее, чем поиск названных тегов – данные можно затем вставить следующим образом:

  With oDoc.Tables(5) For i = 0 To Data.InvoiceDictionary.Count - 1 If i > 0 Then oDoc.Tables(5).rows.Add End If Set invoice = Data.InvoiceDictionary.Items(i) .Cell(i + 2, 1).Range.Text = invoice.InvoiceCCNumber .Cell(i + 2, 2).Range.Text = invoice.InvoiceDate .Cell(i + 2, 3).Range.Text = invoice.TransactionType .Cell(i + 2, 4).Range.Text = invoice.Description .Cell(i + 2, 5).Range.Text = invoice.SumOfValue Next i 

.Cell (i + 1, 4) .Range.Text = “Total:” End. В этом случае строка 1 таблицы была заголовком; строка 2 была пуста, а последующих строк не было, поэтому rows.add применяется еще раз, чем одна строка. Таблицы могут быть очень подробными документами и скрывать границы, а границы ячеек могут быть похожи на обычный текст. Таблицы нумеруются последовательно после streamа документов. (то есть Doc.Tables (1) является первой таблицей …

  • Выберите первую пустую ячейку в столбце F, начиная с строки 1. (без использования смещения)
  • В чем разница между .text, .value и .value2?
  • VBA Runtime Error 1004 «Определенная пользователем или объектная ошибка» при выборе диапазона
  • Простая обработка ошибок VBA Excel
  • Лучший способ протестировать приложение MS Access?
  • В Excel VBA для Windows, для разобранных JSON-переменных, что это такое JScriptTypeInfo?
  • Как удалить строки в Excel на основе критериев с помощью VBA?
  • Excel VBA Copy Вставить только значения (xlPasteValues)
  • Заменить форму массива таблиц с массивом памяти VBA
  • Макрос VBA падает после 32000 строк
  • Выполните команду в командной строке с помощью excel VBA
  • Давайте будем гением компьютера.