Mail Merge with Charts

[Carone]

I'm working on a project for work in which I'm mail merging an excel document to word. The problem is that I have 2 dynamic pie charts as part of the merge. I know that word does not have the capability to utilize merge fields in chart datasheets. I was trying to use VB to combat the problem the problem, however I'm running in to some trouble. I took most of this code from another post. The highlighted part is causing the error.

[Carone]

Sub MergeWithChart()
'Preset the global variables
BeforeMergeExecuted = False
CancelMerge = False
recordIndex = 1

'The events in the class module
'clsMergeEvents will be enabled
ActivateEvents

'As each record is merged
'the MailMergeBeforeMerge
'event will be called
ActiveDocument.MailMerge.Execute Pause:=False

'Turn the events off so that they
'only execute for this document
DeactivateEvents
End Sub
Sub ActivateEvents()
Set x.WdApp = Word.Application
End Sub
Sub DeactivateEvents()
Set x.WdApp = Nothing
End Sub
Function OpenChartDataFile(LocalPath As String) _
As Word.Document
Dim FilePath As String

'Combine the path where the main merge doc
'is stored plus the specified name of the
'document containing the data for the chart
FilePath = U: Benefit "\" & ChartDataDoc

'Make sure the data file exists
'before trying to open it
If Dir(FilePath) <> "" Then
Set OpenChartDataFile = Documents.Open( _
FileName:=FilePath, _
ReadOnly:=True, _
AddToRecentFiles:=False, _
Visible:=False)
End If
End Function
Sub EditChart(rng As Word.Range, _
DataDoc As Word.Document)
Dim of As Word.OLEFormat
Dim oChart As Graph.chart
Dim oDataSheet As Graph.DataSheet
Dim tbl As Word.Table
Dim chartType As Long
Set tbl = DataDoc.Tables(1)
'Activate the MS Graph object in the
'main merge document
Set of = rng.InlineShapes(1).OLEFormat
of.DoVerb wdOLEVerbInPlaceActivate

'Pick up the chart for automation
Set oChart = of.Object

'We want to know whether we have a
'pie chart or not
chartType = oChart.chartType

'We also need the data sheet
Set oDataSheet = oChart.Application.DataSheet
oChart.DisplayBlanksAs = xlNotPlotted
FillDataSheet oDataSheet, tbl, chartType
'Finish with the chart
oChart.Application.Update
oChart.Application.Quit
DoEvents
Set oChart = Nothing
End Sub
Sub FillDataSheet(ByRef ds As Graph.DataSheet, tbl As Word.Table, chartType As Long)
Dim nrDataCols As Long

recordIndex = recordIndex + 1
nrDataCols = tbl.Columns.Count

'Delete all entries in the datasheet
ds.Cells.ClearContents
If chartType = xlPie Then
ProcessPieChart ds, tbl, nrDataCols
Else
ProcessOtherChart ds, tbl, nrDataCols
End If
DoEvents
End Sub
Sub ProcessPieChart(ByRef ds As Graph.DataSheet, _
tbl As Word.Table, ByVal nrDataCols As Long)
Dim rwData As Word.Row
Dim datavalue As Double
Dim rwLabels As Word.Row
Dim colcounter As Long, i As Long
colcounter = 1
'Data series in rows!
ds.Application.PlotBy = xlRows

'First column contains record ID
'Following columns contain data
'One row per record
'First row contains Legend labels
Set rwLabels = tbl.Rows(1)
Set rwData = tbl.Rows(recordIndex)

'Loop through the data columns
For i = 2 To nrDataCols
With ds
datavalue = CDbl(Val( _
TrimCellText(rwData.Cells(i).Range.Text)))
'Don't carry over 0 values
'If you want to use 0 values
'comment out If and End If lines
If datavalue > 0 Then
colcounter = colcounter + 1
'carry over the column header
.Cells(1, colcounter).Value _
= TrimCellText(rwLabels.Cells(i).Range.Text)
'and the data to the data sheet
.Cells(2, colcounter).Value _
= datavalue
End If
End With
Next i
End Sub
Sub ProcessOtherChart(ByRef ds As Graph.DataSheet, _
tbl As Word.Table, ByVal nrDataCols As Long)
Dim rwData As Word.Row
Dim rwLabels As Word.Row
Dim rowCounter As Long
Dim totalRows As Long
Dim ID As String
Dim datavalue As Double
Dim colcounter As Long, i As Long
colcounter = 1
rowCounter = 1
totalRows = tbl.Rows.Count

'Data series in columns!
ds.Application.PlotBy = xlColumns

'First column contains record ID
'Second column contains legend labels
'Following columns contain data
'First row contains x-axis labels
Set rwLabels = tbl.Rows(1)
Set rwData = tbl.Rows(recordIndex)

'There can be multiple rows / merge record
'therefore loop through table rows until
'ID (value in col 1) changes
Do
colcounter = 1
rowCounter = rowCounter + 1
ID = TrimCellText(rwData.Cells(1).Range.Text)

'carry over row header to datasheet
ds.Cells(rowCounter, 1).Value = _
TrimCellText(rwData.Cells(2).Range.Text)

'loop through the columns
For i = 3 To nrDataCols
colcounter = colcounter + 1
With ds
'carry over column header only on first pass
If rowCounter = 2 Then
.Cells(1, colcounter).Value _
= TrimCellText(rwLabels.Cells(i).Range.Text)
End If
'and the data to the data sheet
.Cells(rowCounter, colcounter).Value _
= TrimCellText(rwData.Cells(i).Range.Text)
End With
Next i
recordIndex = recordIndex + 1

'Stop if we've reached the end
If totalRows < recordIndex Then Exit Do

'Otherwise, move to the next row
'Then perform the ID check before looping back
Set rwData = tbl.Rows(recordIndex)
Loop While ID = TrimCellText(rwData.Cells(1).Range.Text)

'Reset in order to start with correct row for next record
recordIndex = recordIndex - 1
End Sub
Function TrimCellText(s As String) As String
'Remove end-of-cell markers
TrimCellText = Left(s, Len(s) - 2)
End Function

[Nelviticus]

You need to include a reference to the Microsoft Graph libraries. Go to the 'Tools' menu (in the VB editor) and choose 'References', then scroll down to 'Microsoft Graph x.x Object Library'. Tick it and click 'OK'. The value of x.x depends on what version of Office you're running - Office XP is 10.0.

Regards