Excel - 从 Word 模板文档生成输出 Word 文件

Question

我有一个简单的 Excel VBA 例程来使用模板文本文件并将其中的关键标签替换为 Excel 数组中的值，其中包含可变行/列。它工作得很好，在过去的几年里为我节省了大量时间。

现在我需要做同样的事情，但读取/导出一个 word 文档。

它正在杀死我。我尝试了很多示例，但我得到的只是一个输出文件，它是我正在使用的未修改的模板页面；我正在搜索的所有原始关键字，但没有一个替换关键字，即使我的调试提要显示所有键的命中都是肯定的。

Public Sub LogicGen(ActiveSheet As String)
    On Error Resume Next
    DebugMode = True 'Prints some extra data to the debugger window
    'Variables
     Dim Filename As String
     Dim WorkbookPath As String
     Dim KeyInput As Variant
     Dim i As Integer
     Dim END_OF_STORY
     Dim MOVE_SELECTION

     END_OF_STORY = 6
     MOVE_SELECTION = 0

    'Activate a worksheet
    Worksheets(ActiveSheet).Activate


    'Figure out how many keys were entered
    i = 2
    KeyInput = Cells(6, i)
    Do Until IsEmpty(KeyInput)
        i = i + 1
        KeyInput = Cells(6, i)
    Loop
    ' Key count is the empty address minus 2
    KeyCount = i - 2

    ' push those keys into an array
    Dim KeyArray() As String
    ReDim KeyArray(0 To KeyCount) As String
    For i = LBound(KeyArray) To UBound(KeyArray)
        KeyArray(i) = Cells(6, i + 2)
        If DebugMode Then
            'Debug.Print KeyArray(i)
        End If
    Next i

    'KeyArray now has all of the key values, which will be reused for each of the tags
    WorkbookPath = ActiveWorkbook.Path

    'Determine how many rows are populated by counting the template cells
    TemplateInput = Cells(7, 1)

    RowCount = 0
    Do Until IsEmpty(TemplateInput)
        RowCount = RowCount + 1
        TemplateInput = Cells(RowCount + 7, 2)
    Loop
    OutputFilePath = WorkbookPath & "\" & Cells(1, 2)

    'Create an output file
    On Error Resume Next
    Set OutputApp = GetObject(, "Word.Application")
    If Err.Number <> 0 Then
        Set OutputApp = CreateObject("word.application")
    End If
    On Error GoTo 0

    Set OutputDoc = OutputApp.Documents.Add
    Set OutputSelection = OutputApp.Selection



    'build a Build a 2D array for the tag values, with the associated
    'tag values.
     Dim TagArray() As String
     ReDim TagArray(0 To RowCount, 0 To KeyCount)


    ' Step down through all of the rows that have been entered
    For i = 0 To RowCount - 1

        'Build an array of all of the tags
         For KeyIndex = 0 To KeyCount
            TagArray(i, KeyIndex) = Cells(i + 7, KeyIndex + 2).Text
            If DebugMode Then
                'Debug.Print TagArray(i, KeyIndex)
            End If
        Next KeyIndex

        'Ensure template file exists, once per row
        Filename = WorkbookPath & "\" & Cells(i + 7, 1).Text

        ' Check for existance of template file, and open if it exists
        If Not FileFolderExists(Filename) Then
            MsgBox (Filename & " does not exist")
            GoTo EarlyExit
        Else
           'Grab the template file and push it to the output
            Set TemplateApp = CreateObject("word.application")
            Set TemplateDoc = TemplateApp.Documents.Open(Filename)
            Set TemplateSel = TemplateApp.Selection
            TemplateDoc.Range.Select
            TemplateDoc.Range.Copy
            OutputSelection.endkey END_OF_STORY, MOVE_SELECTION
            OutputSelection.TypeParagraph
            OutputSelection.Paste

            'Clear the template file, since we don't know if it will be the same next time
            TemplateDoc.Close
            TemplateApp.Quit
            Set TemplateApp = Nothing
        End If


        'Iterate through all of the keys to be replaced
        For j = 0 To KeyCount - 1
            For Each storyrange In OutputDoc.StoryRanges
                Do
                    With storyrange.Find
                        .Text = KeyArray(j)
                        .Replacement.Text = TagArray(i, j)
                        .Wrap = wdFindContinue
                        .Execute Replace:=wdReplaceAll

                        If .Execute(Replace:=wdReplaceAll) Then
                            Debug.Print "Replacing: " & KeyArray(j) & " With: " & TagArray(i, j)
                        End If
                    End With
                    Set storyrange = storyrange.nextstoryrange
            Loop While Not storyrange Is Nothing
           Next

        Next j

    Next i

    OutputDoc.SaveAs (OutputFilePath)


EarlyExit:
' Close the files that were opened

OutputDoc.Close
OutputApp.Quit
Set OutputDoc = Nothing

即使我的调试监视器充满了以下内容：

Replacing: %EULow% With: 0
Replacing: %EUHigh% With: 100
Replacing: %AlarmHH% With: No HH
Replacing: %AlarmH% With: No H
Replacing: %AlarmL% With: No L

我的输出文档仍然是许多页的 Word 表格，其中 %something% 标记没有被替换。我快疯了——我整天都在做这个。

这就是它崩溃的地方：

For Each storyrange In OutputDoc.StoryRanges
                Do
                    With storyrange.Find
                        .Text = KeyArray(j)
                        .Replacement.Text = TagArray(i, j)
                        .Wrap = wdFindContinue
                        .Execute Replace:=wdReplaceAll

                        If .Execute(Replace:=wdReplaceAll) Then
                            Debug.Print "Replacing: " & KeyArray(j) & " With: " & TagArray(i, j)
                        End If
                    End With
                    Set storyrange = storyrange.nextstoryrange
            Loop While Not storyrange Is Nothing
           Next

我已尝试进行此搜索并替换来自不同示例的 7 种不同方式，实际上没有任何内容可以替换文本。

Answer 1

问题几乎可以肯定是您使用的是“后期绑定”（这很好），并且没有引用 Word 对象模型，这意味着由 Word 对象模型定义的常量，例如“wdFindContinue”和“wdReplaceAll”将是“空的”。 Word Object 模型中的值分别为 1 和 2。

您可以通过VB编辑器的Tools->References菜单引用Word对象模型（这样做有好处也有坏处），并引用其中的常量，或者定义您自己的具有相同名称和正确值的常量，或者只使用正确的常量值。

如果您选择引用 Word 对象模型，VBA 应该选择 Word 常量值，无需额外限定，即

debug.print wdReplaceAll

现在应该在即时窗口中显示“2”>

但是，有些人更喜欢说明这些常量的来源，例如通过

Word.wdReplaceAll 

或者更具体的

Word.wdReplace.wdReplaceAll

如果您想查看 Debug.Print 输出，您还应该删除代码中的第一个 .Execute Replace:=ReplaceAll （因为它会正常工作，因此在第二个 .Execute 时将找不到搜索字符串方法被调用）。