Excel - Создание выходного файла Word из документов шаблона Word

Question

У меня есть простая процедура excel VBA для использования текстовых файлов шаблонов и замена в них ключевых тегов значениями из массива Excel с переменными строками/столбцами. Он отлично работает и спас меня много раз в течение последних нескольких лет.

Теперь мне нужно сделать то же самое, но прочитать/экспортировать документ слов.

Это УБИВАЕТ меня. Я пытался следовать многочисленным примерам, но все, что я получаю, - это выходной файл, который является немодифицированными страницами шаблонов, которые я использую; все исходные ключевые слова, которые я ищу, но ни одна из замен, даже когда мой отладочный фид показывает положительные удары для всех ключей.

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 

Мой выходной документ еще множество страниц таблиц слов с% тегами% что-то не заменили. Я схожу с ума - я работаю над этим весь день.

Это где это разрушение:

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 равны 1 и 2 соответственно.

Вы можете ссылаться на объектную модель Word (есть преимущества и недостатки этого) в меню «Инструменты» -> «Ссылки» VB Editor и ссылаться на константы в ней или определять собственные константы с тем же именем и правильные значений или просто используйте правильные значения констант.

Если вы ссылаться на модели объекта Word, VBA должен подобрать постоянные значения Word, без дополнительной квалификации, т.е.

debug.print wdReplaceAll 

теперь должен отображаться «2» в открывшемся окне>

Однако некоторые люди предпочитают излагать происхождение этих констант, например через

Word.wdReplaceAll 

или быть еще более конкретным

Word.wdReplace.wdReplaceAll 

Если вы хотите увидеть выход Debug.Print, вы должны удалить первый .Execute Заменить: = ReplaceAll в коде (потому что это будет работать правильно, поэтому строка поиска не будет найдена при вызове второго метода .Execute).