VBA Copying Multiple Excel Charts Into Word At Specific Cursor Location

smithan04

New Member
Joined
Jul 18, 2011
Messages
18
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
 

Excel Facts

Quick Sum
Select a range of cells. The total appears in bottom right of Excel screen. Right-click total to add Max, Min, Count, Average.

Forum statistics

Threads
1,213,510
Messages
6,114,040
Members
448,543
Latest member
MartinLarkin

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top