Question

嘿所有人。我会尽量简单明了。：）

我有

40个左右的样板文字文件，其中包含一系列需要填写的字段（名称，地址等）。这在历史上是手工完成的，但它是重复和繁琐的。
用户填写了大量个人信息的工作簿。

我需要

以编程方式（从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＃”）并打开每个文档进行搜索和替换。如果没有提出更优雅的话，我会采用这个解决方案。

Answer 1

自从我提出这个问题以来已经很长时间了，我的解决方案经历了越来越多的改进。我必须处理各种特殊情况，例如直接来自工作簿的值，需要根据列表专门生成的部分，以及需要在页眉和页脚中进行替换。

事实证明，使用书签是不够的，因为用户以后可以编辑文档来更改，添加和删除文档中的占位符值。事实上，解决方案是使用关键字，例如：

enter image description here

这只是一个示例文档中的一个页面，它使用了一些可以自动插入到文档中的可能值。存在超过50个具有完全不同的结构和布局并使用不同参数的文档。 word文档和excel电子表格共享的唯一常识是了解这些占位符值的含义。在excel中，它存储在文档生成关键字列表中，其中包含关键字，后跟对实际包含此值的范围的引用：

enter image description here

这些是所需的关键两种成分。现在有了一些聪明的代码，我所要做的就是遍历要生成的每个文档，然后遍历所有已知关键字的范围，并对每个文档中的每个关键字进行搜索和替换。

首先，我有一个包装器方法，它负责维护一个微软单词实例迭代所有选择用于生成的文档，编号文档和执行用户界面的东西（比如处理错误，向用户显示文件夹）等等。）

' 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一堆字来判断它们不存在，然后不加选择地调用replace，所以我们总是在尝试之前检查关键字是否存在替换它。

' 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

这就是橡胶遇到道路的地方 - 执行替换的代码。当我遇到困难时，这个程序变得更加复杂。以下是您只能从经验中学到的课程：

您可以直接设置替换文本，也可以使用剪贴板。我发现如果你使用长度超过255个字符的字符串进行VBA替换，那么如果你试图将它放在Find.Replacement.Text中，那么文本就会被截断，但你可以使用{{1作为替换文本，它将直接从剪贴板中获取。这是我使用的解决方法。
简单地调用replace会在页眉和页脚等文本区域中遗漏关键字。因此，您实际上需要遍历"^c"并运行搜索并替换每一个以确保您捕获要替换的单词的所有实例。
如果您直接设置document.StoryRanges，则需要使用简单Replacement.Text转换Excel换行符（vbNewLine和Chr(10)）它们在单词中正确显示。否则，在替换文本中有来自excel单元格的换行符的任何地方最终会将奇怪的符号插入到单词中。但是，如果使用剪贴板方法，则无需执行此操作，因为换行符会在放入剪贴板时自动转换。

这解释了一切。评论也应该很清楚。这是执行魔术的黄金例程：

vbCr

当尘埃落定时，我们会留下一个漂亮的初始文档版本，并用生产值代替那些散列标记的关键字。我喜欢展示一个例子，但当然每个填写的文档都包含所有专有信息。

我想的唯一想法就是' 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()

生成的字符串可以像任何excel单元格的内容一样使用，并传递给替换函数，如果超过255个字符，它将适当地使用剪贴板方法。

所以这个模板：

enter image description here

此电子表格数据：

enter image description here

成为此文档：

enter image description here

我真诚地希望有一天能帮助某人。这绝对是一项艰巨的任务，也是一个必须重新发明的复杂轮子。该应用程序非常庞大，拥有超过50,000行的VBA代码，因此，如果我在我的代码中引用某个人需要的关键方法，请发表评论并在此处添加。

Answer 2

http://www.computorcompanion.com/LPMArticle.asp?ID=224介绍使用Word 书签

文档中的一段文字可以加入书签，并给出一个变量名称。使用VBA，可以访问此变量，并且可以使用备用内容替换文档中的内容。这是在文档中使用名称和地址等占位符的解决方案。

此外，使用书签，可以修改文档以引用书签文本。如果名称在整个文档中多次出现，则第一个实例可以加入书签，其他实例可以引用该书签。现在，当以编程方式更改第一个实例时，整个文档中变量的所有其他实例也会自动更改。

现在所需要的只是通过为占位符文本添加书签并在整个文档中使用一致的命名约定来更新所有文档，然后遍历每个文档替换书签（如果存在）：

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

在尝试每次替换之前，我可以使用on error resume next子句解决在给定文档中没有出现的变量问题。

感谢Doug Glancy在评论中提到了书签的存在。我事先并不知道他们的存在。我将保留这个主题是否足够。

Answer 3

您可以考虑使用基于XML的方法。

Word具有称为自定义XML数据绑定或数据绑定内容控件的功能。内容控件本质上是文档中可以包含内容的一个点。 “数据绑定”内容控件从您包含在docx zip文件中的XML文档中获取其内容。 XPath表达式用于表示XML的哪个位。所以你需要做的就是包含你的XML文件，Word将完成剩下的工作。

Excel有办法将数据作为XML从中获取，因此整个解决方案应该可以很好地工作。

关于MSDN上的内容控制数据绑定有很多信息（其中一些已经在之前的SO问题中被引用）所以我不打算在这里包括它们。

但是你确实需要一种设置绑定的方法。您可以使用Content Control Toolkit，或者如果您想在Word，我的OpenDoPE插件中执行此操作。

Answer 4

完成了类似的任务后，我发现在表中插入值要比搜索命名标签快得多 - 然后可以像这样插入数据：

    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 =＆＃34; Total：＆＃34; 结束在这种情况下，表格的第1行是标题;第2行是空的，没有其他行 - 因此rows.add仅在连接一行时应用。表格可以是非常详细的文档，通过隐藏边框和单元格边框可以看起来像普通文本。表格按文件流程顺序编号。（即Doc.Tables（1）是第一个表......

从一系列文档模板生成Word文档（在Excel VBA中）

4 个答案: