Есть ли способ использовать Excel VBA, чтобы открыть документ Word, скопировать таблицу слов и вставить его в другой документ Word

Question

Я пытаюсь использовать справочную таблицу в Excel, содержащую имена файлов и заголовки текстовых документов, чтобы открыть ссылочный документ, найти ссылочный заголовок, а затем скопировать заголовок (с содержимым) и вставить его в другой текстовый документ.

Слово документы обычно содержат три заголовка.Внутри каждого заголовка обычно есть 5 абзацев.Во втором абзаце каждого заголовка обычно есть изображение (расширенный метафайл).Мой текущий код, хотя и некрасивый, похоже, делает эту работу.Однако для некоторых документов слова второй абзац содержит либо таблицу слов 1х3, либо таблицу слов 2х3.В первом ряду есть заголовок, во втором ряду картинка (расширенный метафайл) и в третьем ряду исходные заметки.Для таблиц 2x3 второй столбец содержит информацию того же типа, что и первый столбец.

Я предпринял несколько слабых попыток использования объектов .Selection и table, но мой мозг на самом деле не понимает, как их использовать.Теперь я нахожусь в тупике в течение нескольких дней и мне нужна помощь.

Поскольку я новичок в VBA, я скопировал весь код.Приношу свои извинения за это, но я не хотел ничего упускать.

Option Explicit

Private Sub CommandButton1_Click()

Dim WordApp As Object
Dim GEB As Object
Dim RoundUp As Object
Dim myrange As Object
Dim forum As String
Dim column As String
Dim GEBIssue As String
Dim i As Integer
Dim j As Integer
Dim k As Integer
Dim l As Integer
Dim parg As Integer

'References a drop down box that contains either G7 Economic Observer or G20 Economic Roundup
forum = ThisWorkbook.Sheets("4 - Add entries to roundup").Cells(24, "A").Value
'Column B contains an X if the country is part of the G7 and column C contains an X if the country is part of the G20
If forum = "G7 Economic Observer" Then column = "B" Else column = "C"
Set WordApp = CreateObject("word.application")
Set RoundUp = WordApp.documents.Open("\\ecnoffice05\ilab\ZZ OELR\2. OELR Research\6. Global Economic Briefing\" & forum & " template.docx")

'Rows 2 to 21 contain information on each of the G7 and G20 countries
For i = 2 To 21
  'Columns 4,6,8 contain the name of the word document and columns 5,7,9 contain the name of the word document heading that needs to be copied
  'Issue, columns 8 and 9 pertain to trade entries that contain either a 1x3 or 2x3 table which doesn't seem to copy
  For l = 4 To 8 Step 2
    If ThisWorkbook.Sheets("4 - Add entries to roundup").Cells(i, column).Value = "X" Then
        If IsError(ThisWorkbook.Sheets("4 - Add entries to roundup").Cells(i, l).Value) = False Then
        GEBIssue = ThisWorkbook.Sheets("4 - Add entries to roundup").Cells(i, l).Value
        Set GEB = WordApp.documents.Open("O:\ZZ OELR\2. OELR Research\6. Global Economic Briefing\Final Briefings Distributed\" & GEBIssue & ".docx")
            parg = GEB.Paragraphs.Count
                For j = 1 To parg
                    If GEB.Paragraphs(j).Range.Text = ThisWorkbook.Sheets("4 - Add entries to roundup").Cells(i, l + 1).Value Then
                    'Rudimentary way to copy/paste the heading and content.  Ideally, I'd like to simply select the heading plus content and copy/paste as one unit
                    For k = 0 To 5
                        GEB.Paragraphs(j + k).Range.Copy
                        'Locates the end of the document so the copied content can be pasted at end
                        Set myrange = RoundUp.Range(Start:=RoundUp.Content.End - 1, End:=RoundUp.Content.End - 1)
                        myrange.Paste
                    Next k
                    End If
                Next j
                GEB.Close (False)
        End If
    End If
  Next l
Next i
RoundUp.SaveAs ("\\ecnoffice05\ilab\ZZ OELR\2. OELR Research\6. Global Economic Briefing\" & forum & " draft 1.docx")
RoundUp.Close (True)
WordApp.Quit

End Sub

В идеале я хотел бы иметь возможность искать и находить определенный заголовок, выбирать этот заголовок и его содержимое (однакомногие абзацы и рисунки, которые он может содержать), скопируйте его, а затем вставьте его в конец другого текстового документа.

Однако, когда моя программа запускается в одной из этих таблиц, я получаю ошибку времени выполнения '4605 '- Ошибка приложения или объекта.

Answer 1

Если в вашем «заголовке» используется стиль заголовка Word, вы можете использовать такой код:

Set WordApp = CreateObject("word.application")
Set RoundUp = WordApp.Documents.Add("\\ecnoffice05\ilab\ZZ OELR\2. OELR Research\6. Global Economic Briefing\" & forum & " template.docx")
'Rows 2 to 21 contain information on each of the G7 and G20 countries
With ThisWorkbook.Sheets("4 - Add entries to roundup")
  For i = 2 To 21
    'Columns 4,6,8 contain the name of the word document and columns 5,7,9 contain the name of the word document heading that needs to be copied
    'Issue, columns 8 and 9 pertain to trade entries that contain either a 1x3 or 2x3 table which doesn't seem to copy
    For l = 4 To 8 Step 2
      If .Cells(i, column).Value = "X" Then
        If IsError(.Cells(i, l).Value) = False Then
          GEBIssue = .Cells(i, l).Value
          Set GEB = WordApp.Documents.Open("O:\ZZ OELR\2. OELR Research\6. Global Economic Briefing\Final Briefings Distributed\" & GEBIssue & ".docx")
          With GEB
            With .Range
              With .Find
                .ClearFormatting
                .Text = ThisWorkbook.Sheets("4 - Add entries to roundup").Cells(i, l + 1).Value
                .Execute
              End With
              If .Find.Found = True Then
                Set myrange = .Duplicate
                Set myrange = myrange.GoTo(What:=-1, Name:="\HeadingLevel") ' -1 = wdGoToBookmark
                RoundUp.Characters.Last.FormattedText = myrange.FormattedText
              End If
            End With
            .Close False
          End With
        End If
      End If
    Next l
  Next i
End With
RoundUp.SaveAs ("\\ecnoffice05\ilab\ZZ OELR\2. OELR Research\6. Global Economic Briefing\" & forum & " draft 1.docx")
RoundUp.Close False
WordApp.Quit

Примечание: Вы должны использовать настоящий шаблон Word (т.е. файл dotx) в качестве шаблона, а не документа.