Скопируйте и вставьте ячейки / таблицы из Excel в шаблон Word (и в правильное положение)

Question

У меня есть следующий код:

Sub Excel2Word()
Dim BottomEquity As Range, BottomBond As Range
Dim WordApp As Word.Application
Set SB = Worksheets("SalesBrokerage")
Set WordApp = CreateObject("Word.Application")
WordApp.Documents.Open "C:\Customer\Templates\PIntern.dotx"
SB.Range("B3:G" & SB.Cells(SB.Rows.Count, 2).End(xlUp).Offset(1, 0).Row).Select
Selection.PasteExcelTable
HorizontalPosition = 10
VerticalPosition = 15
End Sub

У меня всегда возникают проблемы при Selection.PasteExcelTable, и, очевидно, HorizontalPosition и VerticalPosition также не будут истинными.

Шаблон Word, в который я хочу вставить, выглядит следующим образом:

                       Our Overview
Equities 
Bonds

Я хочу сделать то же самое, что скопировать выбранный диапазон в моем документе Excel, открыть шаблон Word, вставить таблицу между «акциями»и "облигации", а затем сохранение документа.

Answer 1

Нет необходимости использовать выделение, просто скопируйте и вставьте в соответствующие объекты.

Будет выполнен поиск первого Гравийного персонажа и его замена на скопированную вами таблицу.Также сохранено и закрыто слово документ.

Sub Excel2Word()
    Dim BottomEquity As Range, BottomBond As Range
    Dim WordApp As New Word.Application

    Set SB = Worksheets("SalesBrokerage")
    'Set WordApp = CreateObject("Word.Application") ' You already have reference, this is not needed.
    WordApp.Documents.Open "C:\Customer\Templates\PIntern.dotx"
    WordApp.Visible = True                          ' Added for testing to see document

    'Copy / Paste
    SB.Range("B3:G" & SB.Cells(SB.Rows.Count, 2).End(xlUp).Offset(1, 0).Row).Copy

    Dim oFindPos As Long
    WordApp.Documents(1).Application.Selection.Find.Execute findtext:="`"
    oFindPos = WordApp.Documents(1).Application.Selection.Start

    WordApp.Documents(1).Range(oFindPos, oFindPos + 1).Paste

    'Save & Close Word Doc
    WordApp.Documents(1).Save
    WordApp.Documents(1).Close
    WordApp.Quit
End Sub