Прошло много времени с тех пор, как я задавал этот вопрос, и мое решение претерпевало все больше и больше доработок.Мне приходилось иметь дело со всевозможными особыми случаями, такими как значения, которые поступают непосредственно из рабочей книги, разделы, которые должны быть специально сгенерированы на основе списков, и необходимость делать замены в верхних и нижних колонтитулах.
Как оказалось, использования закладок было недостаточно, поскольку пользователи могли позже редактировать документы, чтобы изменять, добавлять и удалять значения заполнителей из документов.Фактически, решение заключалось в использовании ключевых слов , таких как:
Это просто страница из образца документа, которая использует некоторые из возможных значений, которыеможет быть автоматически вставлен в документ.Существует более 50 документов с совершенно разными структурами и макетами и с разными параметрами.Единственное общеизвестное знание, которым обладают документы Word и электронная таблица Excel, - это знание того, что означают эти значения заполнителей.В Excel это сохраняется в списке ключевых слов генерации документа, которые содержат ключевое слово, сопровождаемое ссылкой на диапазон, который фактически содержит это значение:
Это былиключевые два необходимых ингредиента.Теперь, когда у меня был какой-то умный код, все, что мне нужно было сделать, - это перебрать каждый генерируемый документ, а затем перебрать весь диапазон всех известных ключевых слов и выполнить поиск и замену каждого ключевого слова в каждом документе.
Во-первых, у меня есть метод-обертка, который заботится о том, чтобы поддерживать экземпляр слова Microsoftsoft, повторяющийся по всем документам, выбранным для генерации, нумерации документов, и выполнять вещи пользовательского интерфейса (например, обработку ошибок, отображение папки для пользователя).и т. д.)
' 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 кучу слов, чтобы выяснить, что они не существуют, а затем вызвать замену без разбора, поэтому мы всегда проверяем, существует ли ключевое слово, прежде чем пытаться заменить его.
' 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
И вот где резина встречается с дорогой - код, который выполняет замену.Эта рутина стала более сложной, так как я столкнулся с трудностями.Вот уроки, которые вы узнаете только из опыта:
Вы можете установить текст замены напрямую или использовать буфер обмена.Я обнаружил, что если вы выполняете замену слова VBA в слове, используя строку длиной более 255 символов, текст будет урезан, если вы попытаетесь поместить его в Find.Replacement.Text, но вы можете использовать "^c" в качестветекст замены, и он получит его прямо из буфера обмена.Это был обходной путь, который я должен использовать.
Простой вызов замены пропустит ключевые слова в некоторых текстовых областях, таких как верхние и нижние колонтитулы.Из-за этого вам действительно нужно перебрать document.StoryRanges и запустить поиск и замену каждого из них, чтобы убедиться, что вы перехватываете все вхождения слова, которое хотите заменить.
Если вы устанавливаете 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. Он делает нечто очень похожее - в конечном итоге он вызывает ту же самую функцию 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, поэтому, если я ссылаюсь на важный метод в своем коде, где-то, что кому-то нужно, оставьте комментарий, и я добавлю его сюда.