Moving a chart from Excel to Word

**nbuk** · 07-21-2010, 11:08 AM

I have the following code so far:

'Open Word
        Dim wrdApp As word.Application
        Dim wrdDoc As word.Document
        Set wrdApp = CreateObject("Word.Application")
        wrdApp.Visible = True
        Set wrdDoc = wrdApp.Documents.Add
'Create charts
        With Sheet1.ChartObjects.Add(Left:=390, Width:=375, Top:=25, Height:=225)
        .chart.SetSourceData Source:=Sheet22.Range("A1:L2")
        .chart.ChartType = xlColumnClustered
        .chart.ChartTitle.Characters.Text = "REVERB1 Downtime " & StartDate & "-" & EndDate
        .chart.SetElement (msoElementPrimaryValueAxisTitleRotated)
        .chart.Axes(xlValue, xlPrimary).AxisTitle.Text = "Total Minutes"
        .chart.Legend.delete
        End With
        
        With Sheet1.ChartObjects.Add(Left:=775, Width:=375, Top:=25, Height:=225)
        .chart.SetSourceData Source:=Sheet22.Range("A3:L4")
        .chart.ChartType = xlColumnClustered
        .chart.ChartTitle.Characters.Text = "REVERB2 Downtime " & StartDate & "-" & EndDate
        .chart.SetElement (msoElementPrimaryValueAxisTitleRotated)
        .chart.Axes(xlValue, xlPrimary).AxisTitle.Text = "Total Minutes"
        .chart.Legend.delete
        End With
        
        With Sheet1.ChartObjects.Add(Left:=390, Width:=375, Top:=260, Height:=225)
        .chart.SetSourceData Source:=Sheet22.Range("A5:L6,A8:L8")
        .chart.ChartType = xlColumnClustered
        .chart.SetElement (msoElementPrimaryValueAxisTitleRotated)
        .chart.Axes(xlValue, xlPrimary).AxisTitle.Text = "Total Minutes"
        .chart.HasTitle = True
        .chart.ChartTitle.Characters.Text = "REVERBs Downtime " & StartDate & "-" & EndDate
        End With

A new Word file opens great, but what I need to do from here is modify the chart code so that the charts will be created in the word document instead of sheet1.

This thread is also posted at http://www.mrexcel.com/forum/showthread.php?t=482691 but I have not received any help there yet.

Any suggestions are greatly appreciated.

**nbuk** · 07-21-2010, 11:30 AM

Solution:

        Dim wrdApp As word.Application
        Dim wrdDoc As word.Document
        Set wrdApp = CreateObject("Word.Application")
        wrdApp.Visible = True
        Set wrdDoc = wrdApp.Documents.Add
        
        With Sheet1.ChartObjects.Add(Left:=390, Width:=375, Top:=25, Height:=225)
        .chart.SetSourceData Source:=Sheet22.Range("A1:L2")
        .chart.ChartType = xlColumnClustered
        .chart.ChartTitle.Characters.Text = "REVERB1 Downtime " & StartDate & "-" & EndDate
        .chart.SetElement (msoElementPrimaryValueAxisTitleRotated)
        .chart.Axes(xlValue, xlPrimary).AxisTitle.Text = "Total Minutes"
        .chart.Legend.Delete
        .chart.CopyPicture Appearance:=xlScreen, Format:=xlPicture
        End With
        
        wrdApp.Selection.PasteSpecial Link:=False, DataType:=wdPasteMetafilePicture, _
        Placement:=wdInLine, DisplayAsIcon:=False
        
        With Sheet1.ChartObjects.Add(Left:=775, Width:=375, Top:=25, Height:=225)
        .chart.SetSourceData Source:=Sheet22.Range("A3:L4")
        .chart.ChartType = xlColumnClustered
        .chart.ChartTitle.Characters.Text = "REVERB2 Downtime " & StartDate & "-" & EndDate
        .chart.SetElement (msoElementPrimaryValueAxisTitleRotated)
        .chart.Axes(xlValue, xlPrimary).AxisTitle.Text = "Total Minutes"
        .chart.Legend.Delete
        .chart.CopyPicture Appearance:=xlScreen, Format:=xlPicture
        End With
        
        wrdApp.Selection.PasteSpecial Link:=False, DataType:=wdPasteMetafilePicture, _
        Placement:=wdInLine, DisplayAsIcon:=False
        
        With Sheet1.ChartObjects.Add(Left:=390, Width:=375, Top:=260, Height:=225)
        .chart.SetSourceData Source:=Sheet22.Range("A5:L6,A8:L8")
        .chart.ChartType = xlColumnClustered
        .chart.SetElement (msoElementPrimaryValueAxisTitleRotated)
        .chart.Axes(xlValue, xlPrimary).AxisTitle.Text = "Total Minutes"
        .chart.HasTitle = True
        .chart.ChartTitle.Characters.Text = "REVERBs Downtime " & StartDate & "-" & EndDate
        .chart.CopyPicture Appearance:=xlScreen, Format:=xlPicture
        End With
        
        wrdApp.Selection.PasteSpecial Link:=False, DataType:=wdPasteMetafilePicture, _
        Placement:=wdInLine, DisplayAsIcon:=False
        
        Set wrdDoc = Nothing
        Set wrdApp = Nothing
        
        'Delete charts
        Dim chtObj As ChartObject

        For Each chtObj In Sheet1.ChartObjects
            chtObj.Delete
        Next

Hope this helps someone.