copy chart from excel to word

As for first part of question:

Sub Button1_Click()


Dim wd As New Word.Application
Dim doc As Word.Document
Dim myChart As ChartObject
Set doc = wd.Documents.Add
wd.Visible = True

For Each myChart In ActiveSheet.ChartObjects
myChart.Copy
wd.Selection.PasteSpecial _
Link:=False, _
DataType:=wdPasteEnhancedMetafile, _
Placement:=wdInLine, _
DisplayAsIcon:=False
Next myChart
End Sub

The second is less obvious - in attached file there is no such chart. Assuming you really ment trendline you may use:

Sub Button1_Click()
Dim wd As New Word.Application
Dim doc As Word.Document
Dim myChart As ChartObject, i as integer, hasTrendline As Boolean
Set doc = wd.Documents.Add
wd.Visible = True

For Each myChart In ActiveSheet.ChartObjects
  hasTrendline = False
  For i = 1 To myChart.Chart.SeriesCollection.Count
    If myChart.Chart.SeriesCollection(i).Trendlines.Count > 0 Then hasTrendline = True
  Next i
  If hasTrendline Then
    myChart.Copy
    wd.Selection.PasteSpecial _
    Link:=False, _
    DataType:=wdPasteEnhancedMetafile, _
    Placement:=wdInLine, _
    DisplayAsIcon:=False
  End If
Next myChart
End Sub

As I wrote - in attached file there was no chart with trendline.To create trendline you need scatterplot.

Originally Posted by Kaper

As I wrote - in attached file there was no chart with trendline.To create trendline you need scatterplot.

ooh...i finally got what you mean now...

sorry, my bad ..i guess i didn't explain it clearly in my first post. i shoudn't use the word "trendline" ...perhaps should be "line" instead?..let me rephrase my sentence again..

for example, in my attached spreadsheet, there are 2 charts (Age & Score), lets say if the "Age" chart is showing the line and the "Score" chart doesn't show the line (as shown in the image below). If i click on the macro button, only the "Age" chart should be copied to microsoft word.

noScore.jpg


(i tried adding trendline to my chart and your 2nd script works . Exactly the concept i wanted, but how do i modify the script to capture "line" or "bar" etc instead of "trendline" ?)

But here is no line because of just no data. If it is the case, then:

Sub Button1_Click()
Dim wd As New Word.Application
Dim doc As Word.Document
Dim myChart As ChartObject, i As Integer, seriesFormula As String
Dim rng As Range, hasNonempty As Boolean
Set doc = wd.Documents.Add
wd.Visible = True

For Each myChart In ActiveSheet.ChartObjects
  hasNonempty = False
  For i = 1 To myChart.Chart.SeriesCollection.Count
    seriesFormula = myChart.Chart.SeriesCollection(i).Formula
    seriesFormula = Mid(Left(seriesFormula, Len(seriesFormula) - 3), InStrRev(seriesFormula, "!") + 1)
    For Each rng In Range(seriesFormula)
      If Not IsEmpty(rng) Then hasNonempty = True
    Next rng
  Next i
  If hasNonempty Then
    myChart.Copy
    wd.Selection.PasteSpecial _
    Link:=False, _
    DataType:=wdPasteEnhancedMetafile, _
    Placement:=wdInLine, _
    DisplayAsIcon:=False
  End If
Next myChart
End Sub

will do.

If the cells are not really empty, but there are formulas returnumg "" (so they just look like empty) change inner loop to:

    For Each rng In Range(seriesFormula)
      If Val(rng) <> 0 Then hasNonempty = True
    Next rng

Sheet name shall be also found, for instance:

Sub Button1_Click()
Dim wd As New Word.Application
Dim doc As Word.Document
Dim myChart As ChartObject, i As Integer, seriesFormula As String
Dim seriesSheet As String
Dim rng As Range, hasNonempty As Boolean
Set doc = wd.Documents.Add
wd.Visible = True

For Each myChart In ActiveSheet.ChartObjects
  hasNonempty = False
  For i = 1 To myChart.Chart.SeriesCollection.Count
    seriesFormula = myChart.Chart.SeriesCollection(i).Formula
    seriesFormula = Left(seriesFormula, Len(seriesFormula) - 3)
    seriesSheet = Left(seriesFormula, InStrRev(seriesFormula, "!") - 1)
    seriesSheet = Replace(Mid(seriesSheet, InStrRev(seriesSheet, ",") + 1), "'", "")
    seriesFormula = Mid(seriesFormula, InStrRev(seriesFormula, "!") + 1)
    For Each rng In Sheets(seriesSheet).Range(seriesFormula)
      If Not IsEmpty(rng) Then hasNonempty = True
    Next rng
  Next i
  If hasNonempty Then
    myChart.Copy
    wd.Selection.PasteSpecial _
    Link:=False, _
    DataType:=wdPasteEnhancedMetafile, _
    Placement:=wdInLine, _
    DisplayAsIcon:=False
  End If
Next myChart
End Sub