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

问题几乎可以肯定，你正在使用＆＃34;后期绑定＆＃34; （这很好），并没有引用Word对象模型，这意味着由Word对象模型定义的常量，如＆＃34; wdFindContinue＆＃34;和＆＃34; wdReplaceAll＆＃34;将＆＃34;空＆＃34;。 Word对象模型中的值分别为1和2。

您可以通过VB Editor的Tools-＆gt; References菜单引用Word对象模型（这样做的优点和缺点），并引用其中的常量，或者使用相同的方法定义自己的常量名称和正确的值，或者只使用正确的常量值。

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

debug.print wdReplaceAll

现在应该显示＆＃34; 2＆＃34;在立即窗口中＆gt;

但是，有些人更喜欢拼出这些常数的来源，例如：通过

Word.wdReplaceAll

或更具体的

Word.wdReplace.wdReplaceAll

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

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

1 个答案: