Как скопировать таблицы запросов Excel в слово, с текстом между

Question

Я пытаюсь настроить макрос для копирования содержимого моих таблиц запросов Excel в слово в зависимости от того, были ли они повторены. И разделите их строкой текста.

В настоящее время мой код успешно выполняет первую половину, но они объединяются, разрушая макет. Я надеюсь сохранить модульные вставки таблиц, так как позже мне потребуется добавить больше таблиц.

Кроме того, по какой-то причине моя таблица Notes оказалась наверху, это не большая проблема, но я бы предпочел оставить вставки в приказ.

Sub WordOutput3()
Dim objword
Dim objdoc
Dim Selection As Excel.Range
Dim WordTable


'Optimize Code
  Application.ScreenUpdating = False
  Application.EnableEvents = False

'Create Word Doc with Thin Margins
    Set objword = CreateObject("Word.Application")
    Set objdoc = objword.Documents.Add
objword.Visible = True
objdoc.PageSetup.TopMargin = Application.CentimetersToPoints(1.27)
objdoc.PageSetup.BottomMargin = Application.CentimetersToPoints(1.27)
objdoc.PageSetup.LeftMargin = Application.CentimetersToPoints(1.27)
objdoc.PageSetup.RightMargin = Application.CentimetersToPoints(1.27)
    objword.Activate
 'Transactions

 If WorksheetFunction.CountA(Range("Transactions")) >= 1 Then

Set Selection = ThisWorkbook.Worksheets("TF_Flags").ListObjects("Transactions").Range
   Selection.Copy

 'Paste Table into MS Word
  objdoc.Paragraphs(1).Range.PasteExcelTable _
    LinkedToExcel:=False, _
    WordFormatting:=False, _
    RTF:=False
   objdoc.Paragraphs.Add

'Autofit Table so it fits inside Word Document
objword.ActiveDocument.Tables(1).AutoFitBehavior (2)


'Clear The Clipboard
  Application.CutCopyMode = False

   End If

'notes
 If WorksheetFunction.CountA(Range("Notes")) >= 1 Then

Set Selection = ThisWorkbook.Worksheets("TF_Flags").ListObjects("Notes").Range
   Selection.Copy

 'Paste Table into MS Word
  objdoc.Paragraphs(1).Range.PasteExcelTable _
    LinkedToExcel:=False, _
    WordFormatting:=False, _
    RTF:=False


'Autofit Table so it fits inside Word Document
objword.ActiveDocument.Tables(1).AutoFitBehavior (2)

'Clear The Clipboard
  Application.CutCopyMode = False

   End If

End Sub

Answer 1

Все ваши таблицы вставляются в то же место, что и код, который вы используете, помещает их в первый абзац.

objdoc.Paragraphs(1).Range

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

objdoc.Paragraphs.Last.Range

После каждой таблицы должен быть пустой абзац, чтобы Word не мог объединить ваши таблицы в одну. В своем коде вы добавляете новый абзац после добавления первой таблицы, objdoc.Paragraphs.Add, но ничего не делаете с ним. Поскольку вы условно добавляете вторую таблицу, было бы лучше переместить эту строку кода так, чтобы абзац добавлялся перед вставкой во вторую таблицу, т.е.

'Paste Table into MS Word
objdoc.Paragraphs.Add
objdoc.Paragraphs.Last.Range.PasteExcelTable _
  LinkedToExcel:=False, _
  WordFormatting:=False, _
  RTF:=False