VBA Copying Multiple Excel Charts Into Word At Specific Cursor Location

[smithan04]

I have a macro copies text, a table and multiple charts into Word. The problem is when it copies the charts into Word they are placed at the top of the document and I need them to start on Paragraph 8's location. As you will read I have tried many methods from setting the range, to counting the paragraphs to collapsing after the table is inserted but none of it is working. Any guidance is appreciated.

Sub UpdateWordDoc()



Dim filename, filepath
Dim WrdApp As Word.Application
Dim WrdDoc As Word.Document
Dim ChrtObj As ChartObject
Dim WordTable As Word.Table
Dim wdRng As Word.Range

'Open Word Application and Report Document

Set WrdApp = CreateObject("word.Application")
WrdApp.Documents.Open ("H:\Weekly\Weekly_Report.docx")


WrdApp.Visible = True
WrdApp.Activate

Application.DisplayAlerts = False

Set WrdDoc = WrdApp.Documents("Weekly_Report.docx")

'Copies Report Date
Range("M1").Copy
WrdDoc.Paragraphs(2).Range.PasteExcelTable False, False, False
'WrdApp.Selection.PasteSpecial Link:=False, DataType:=wdPasteText, Placement:=wdInLine, DisplayAsIcon:=False

'Copies Tile
Range("O1").Copy
WrdDoc.Paragraphs(4).Range.PasteExcelTable False, False, False


'Copies Excel Table
Set tbl = ThisWorkbook.Worksheets("Publishing").ListObjects("ImportTable").Range
tbl.Copy
'Paste Table into MS Word
WrdDoc.Paragraphs(6).Range.PasteExcelTable _
LinkedToExcel:=False, _
WordFormatting:=False, _
RTF:=False
'Autofit Table so it fits inside Word Document
Set WordTable = WrdDoc.Tables(1)
WordTable.AutoFitBehavior (wdAutoFitWindow)

'Set wdRng = tbl.Range
'wdRng.Collapse wdCollapseEnd


'Loops through the charts on the active sheet and copies them into Report Document

'Set wdRng = wdDoc.ActiveWindow.Paragraphs(8).Range
'Selection.MoveUp Unit:=wdParagraph, Count:=8, Extend:=wdExtend



For Each ChrtObj In ActiveSheet.ChartObjects
ChrtObj.Chart.ChartArea.Copy

With WrdApp.Selection
.PasteSpecial Link:=True, DataType:=wdPasteOLEObject, Placement:=wdInLine
End With
Next ChrtObj


'Names the new Weekly Report Document
filepath = "Z:\00_Weekly Forecast"
filename = "Weekly_Report_" & InputBox("Enter Forecast Date") & ".pdf"
WrdDoc.SaveAs filepath & filename




Application.DisplayAlerts = True






WrdDoc.Close




End Sub