Problem with multiple Excel chart objects in Word

C

CAK

Hi,

If this isn't the correct newsgroup to post in, please let me know the
correct one - thanks.

I'm using Word as my main application, pulling data from an Access
database, and creating Word tables and embedded Excel charts/graphs
based on the bookmarks present in the document. I've been doing this
fairly successfully until now. The current task is to create the same
excel chart, but with different query criteria, in one Word document,
which results in the looping through of the same procedure and
resulting chart insertion about 25 times. This process works great
the first 5 times, but on the 6th run-through, it blows up. The first
5 times, the excel chart is created as an embedded object within the
Word application. But on the 6th time, it creates a separate Excel
application object and creates the object there. I then get an error
saying: "Microsoft Excel has encountered a problem and needs to close.
We are sorry for the inconvenience." with the error signature:
"AppName: excel.exe AppVer: 10.0.4524.0 ModName: excel.exe ModVer:
10.0.4524.0 Offset: 0014859b". I then get either a "-2147221080 -
Automation Error" or "424 - Object Required". Basically, it's telling
me it's lost the Excel connection.

My thought is that I'm not creating and clearing my instances and
variables correctly - something's not getting released, and it keeps
piling up until it blows up. I've tried to be as explicit as possible
in my declarations. The code of the entire procedure is below, sorry
it's very long. I've read through the newsgroups and searched at
Microsoft, but nothing I've tried has helped. If anyone has any
suggestions or can point me in the right direction, I've be very
grateful.

Thanks!
Carla


************* Code Start ******************************


Function InsertGraphProximityPropertyManager(strType As String,
intType As Integer, strClass As String, blnNumbers As Boolean,
strBookMark As String)
On Error GoTo InsertGraphProximityPropertyManager_Error


Dim rsInit As New ADODB.Recordset
Dim rsData As New ADODB.Recordset
Dim rsMean As New ADODB.Recordset
Dim prmSQL(5) As ADODB.Parameter

Dim intCrit As Integer
Dim intOverall As Integer
Dim intOther As Integer
Dim dblMin1 As Double
Dim dblMax1 As Double
Dim dblMin2 As Double
Dim dblMax2 As Double

Dim shpCurrent As Word.InlineShape
Dim objFormat As Word.OLEFormat
Dim rngGraph As Word.Range
Dim xlBook As Excel.Workbook
Dim xlSheet As Excel.Worksheet
Dim xlChart As New Excel.Chart

Dim intMean As Integer
Dim intSeries As Integer
Dim dblMax As Double

If cnnWord.State <> adStateOpen Then
Call ConnectData
End If

' First get the number of property managers to display
Set cmdWord =
catWord.Procedures("WordReportPropertyManagerCriteria").Command
Set prmSQL(0) = cmdWord.CreateParameter("[Region to Run]",
adVarChar, adParamInput, 10, IIf(strType = "Region", intType, "%"))
cmdWord.Parameters.Append prmSQL(0)
Set prmSQL(1) = cmdWord.CreateParameter("[County to Run]",
adVarChar, adParamInput, 10, IIf(strType = "County", intType, "%"))
cmdWord.Parameters.Append prmSQL(1)
Set prmSQL(2) = cmdWord.CreateParameter("[Market to Run]",
adVarChar, adParamInput, 10, IIf(strType = "Market", intType, "%"))
cmdWord.Parameters.Append prmSQL(2)

Set rsInit = cmdWord.Execute
Do Until cmdWord.Parameters.Count = 0
cmdWord.Parameters.Delete cmdWord.Parameters.Count - 1
Loop

If Not rsInit.EOF Then
Select Case strType
Case "Region"
If rsInit!regionpm > 0 Then
intCrit = rsInit!regionpm
Else
intCrit = 10
End If
Case "County"
If rsInit!countypm > 0 Then
intCrit = rsInit!countypm
Else
If rsInit!regionpm > 0 Then
intCrit = rsInit!regionpm
Else
intCrit = 10
End If
End If
Case "Market"
If rsInit!marketpm > 0 Then
intCrit = rsInit!marketpm
Else
If rsInit!countypm > 0 Then
intCrit = rsInit!countypm
Else
If rsInit!regionpm > 0 Then
intCrit = rsInit!regionpm
Else
intCrit = 10
End If
End If
End If
End Select
Else
intCrit = 10
End If

If rsInit.State = adStateOpen Then
rsInit.Close
End If
Set rsInit = Nothing

' Get data
Set cmdWord =
catWord.Procedures("WordReportClassExistPropertyMgrFinal").Command
Set prmSQL(0) = cmdWord.CreateParameter("[County to Run]",
adVarChar, adParamInput, 10, IIf(strType = "County", intType, "%"))
cmdWord.Parameters.Append prmSQL(0)
Set prmSQL(1) = cmdWord.CreateParameter("[Market to Run]",
adVarChar, adParamInput, 10, IIf(strType = "Market", intType, "%"))
cmdWord.Parameters.Append prmSQL(1)
Set prmSQL(2) = cmdWord.CreateParameter("[Date to Run]",
adDate, adParamInput, , ActiveDocument.Variables.Item("ReportDate"))
cmdWord.Parameters.Append prmSQL(2)
Set prmSQL(3) = cmdWord.CreateParameter("[Class to Run]",
adVarChar, adParamInput, 10, "%")
cmdWord.Parameters.Append prmSQL(3)
Set prmSQL(4) = cmdWord.CreateParameter("[Region to Run]",
adVarChar, adParamInput, 10, IIf(strType = "Region", intType, "%"))
cmdWord.Parameters.Append prmSQL(4)
Set rsData = cmdWord.Execute

Do Until cmdWord.Parameters.Count = 0
cmdWord.Parameters.Delete cmdWord.Parameters.Count - 1
Loop

' Get data for averages (use same parameters)
Set cmdWord =
catWord.Procedures("WordReportPropertyManagerMean").Command
Set prmSQL(0) = cmdWord.CreateParameter("[County to Run]",
adVarChar, adParamInput, 10, IIf(strType = "County", intType, "%"))
cmdWord.Parameters.Append prmSQL(0)
Set prmSQL(1) = cmdWord.CreateParameter("[Market to Run]",
adVarChar, adParamInput, 10, IIf(strType = "Market", intType, "%"))
cmdWord.Parameters.Append prmSQL(1)
Set prmSQL(2) = cmdWord.CreateParameter("[Date to Run]",
adDate, adParamInput, , ActiveDocument.Variables.Item("ReportDate"))
cmdWord.Parameters.Append prmSQL(2)
Set prmSQL(3) = cmdWord.CreateParameter("[Class to Run]",
adVarChar, adParamInput, 10, "%")
cmdWord.Parameters.Append prmSQL(3)
Set prmSQL(4) = cmdWord.CreateParameter("[Region to Run]",
adVarChar, adParamInput, 10, IIf(strType = "Region", intType, "%"))
cmdWord.Parameters.Append prmSQL(4)
Set rsMean = cmdWord.Execute
Do Until cmdWord.Parameters.Count = 0
cmdWord.Parameters.Delete cmdWord.Parameters.Count - 1
Loop


' Now let's create the graph wherever the bookmark
'GraphProximityPMTypexClassy' is
If Not rsData.EOF Then
Set shpCurrent =
Selection.InlineShapes.AddOLEObject(ClassType:="Excel.Chart.8",
FileName:="", LinkToFile:=False, DisplayAsIcon:=False)
Set objFormat = shpCurrent.OLEFormat
objFormat.ActivateAs ClassType:="Excel.Chart.8"
objFormat.Activate
Set xlBook = objFormat.Object
Set xlSheet = xlBook.Worksheets(1)
Set xlChart = xlBook.Charts(1)

xlSheet.Cells(1, 1) = "Property Manager"
xlSheet.Cells(1, 2) = "Occupancy"
xlSheet.Cells(1, 3) = "Rental Rate"
xlSheet.Cells(1, 4) = "CalcNRA"
xlSheet.Cells(1, 5) = "CalcVac"
xlSheet.Cells(1, 6) = "CalcRNRA"
xlSheet.Cells(1, 7) = "CalcRate"

intOverall = 2
intOther = 0
dblMin2 = rsData!rentalrate
dblMax2 = rsData!rentalrate
dblMin1 = rsData!occupancy

' Let's set the data up in the worksheet
Do Until rsData.EOF
If rsData!descrpropertymanager = "Other" Then
intOther = intOverall
End If
If intOverall - 1 > intCrit Then
If intOther > 0 Then
xlSheet.Cells(intOther, 4) =
xlSheet.Cells(intOther, 4) + rsData!nra
xlSheet.Cells(intOther, 5) =
xlSheet.Cells(intOther, 5) + rsData!vacant
xlSheet.Cells(intOther, 6) =
xlSheet.Cells(intOther, 6) + rsData!ratenra
xlSheet.Cells(intOther, 7) =
xlSheet.Cells(intOther, 7) + rsData!Rate
xlSheet.Cells(intOther, 2) = Format(1 -
(xlSheet.Cells(intOther, 5) / xlSheet.Cells(intOther, 4)), "Percent")
xlSheet.Cells(intOther, 3) =
Format(xlSheet.Cells(intOther, 7) / xlSheet.Cells(intOther, 6),
"Currency")
Else
If intOverall - 1 = intCrit + 1 Then
xlSheet.Cells(intOverall, 1) = intOverall
- 1
End If
xlSheet.Cells(intOverall, 4) =
xlSheet.Cells(intOverall, 4) + rsData!nra
xlSheet.Cells(intOverall, 5) =
xlSheet.Cells(intOverall, 5) + rsData!vacant
xlSheet.Cells(intOverall, 6) =
xlSheet.Cells(intOverall, 6) + rsData!ratenra
xlSheet.Cells(intOverall, 7) =
xlSheet.Cells(intOverall, 7) + rsData!Rate
xlSheet.Cells(intOverall, 2) = Format(1 -
(xlSheet.Cells(intOverall, 5) / xlSheet.Cells(intOverall, 4)),
"Percent")
xlSheet.Cells(intOverall, 3) =
Format(xlSheet.Cells(intOverall, 7) / xlSheet.Cells(intOverall, 6),
"Currency")
If xlSheet.Cells(intOverall, 2) < dblMin1 Then
dblMin1 = xlSheet.Cells(intOverall, 2)
End If
If xlSheet.Cells(intOverall, 3) < dblMin2 Then
dblMin2 = xlSheet.Cells(intOverall, 3)
End If
If xlSheet.Cells(intOverall, 3) > dblMax2 Then
dblMax2 = xlSheet.Cells(intOverall, 3)
End If
End If
Else
xlSheet.Cells(intOverall, 4) = rsData!nra
xlSheet.Cells(intOverall, 5) = rsData!vacant
xlSheet.Cells(intOverall, 6) = rsData!ratenra
xlSheet.Cells(intOverall, 7) = rsData!Rate
xlSheet.Cells(intOverall, 1) = intOverall - 1
xlSheet.Cells(intOverall, 2) =
Format(rsData!occupancy, "Percent")
xlSheet.Cells(intOverall, 3) =
Format(rsData!rentalrate, "Currency")
If xlSheet.Cells(intOverall, 2) < dblMin1 Then
dblMin1 = xlSheet.Cells(intOverall, 2)
End If
If xlSheet.Cells(intOverall, 3) < dblMin2 Then
dblMin2 = xlSheet.Cells(intOverall, 3)
End If
If xlSheet.Cells(intOverall, 3) > dblMax2 Then
dblMax2 = xlSheet.Cells(intOverall, 3)
End If
intOverall = intOverall + 1
End If

rsData.MoveNext
Loop

If xlSheet.Cells(intOther, 2) < dblMin1 Then
dblMin1 = xlSheet.Cells(intOther, 2)
End If
If xlSheet.Cells(intOther, 3) < dblMin2 Then
dblMin2 = xlSheet.Cells(intOther, 3)
End If
If xlSheet.Cells(intOther, 3) > dblMax2 Then
dblMax2 = xlSheet.Cells(intOther, 3)
End If

rsData.Close
Set rsData = Nothing

' Add the Chart
xlChart.ChartType = xlXYScatter
Do Until xlChart.SeriesCollection.Count = 0
xlChart.SeriesCollection(xlChart.SeriesCollection.Count).Delete
Loop

intSeries = 2

' Add the Data Series
If intOther > 0 Then
intOverall = intOverall - 1
End If
Do Until intSeries > intOverall
xlChart.SeriesCollection.newseries
xlChart.SeriesCollection(intSeries - 1).Name =
xlSheet.Range("A" & intSeries)
xlChart.SeriesCollection(intSeries - 1).Values =
xlSheet.Range("C" & intSeries)
xlChart.SeriesCollection(intSeries - 1).XValues =
xlSheet.Range("B" & intSeries)
If blnNumbers = True Then
xlChart.SeriesCollection(intSeries -
1).DataLabels.Position = xlLabelPositionCenter
xlChart.SeriesCollection(intSeries -
1).MarkerStyle = xlNone
xlChart.SeriesCollection(intSeries -
1).ApplyDataLabels AutoText:=True, LegendKey:= _
False, ShowSeriesName:=True,
ShowCategoryName:=False, ShowValue:=False, _
ShowPercentage:=False, ShowBubbleSize:=False
xlChart.SeriesCollection(intSeries -
1).DataLabels.Interior.ColorIndex = 1
xlChart.SeriesCollection(intSeries -
1).DataLabels.Font.ColorIndex = 2
xlChart.SeriesCollection(intSeries -
1).DataLabels.Font.Size = 6
Else
xlChart.SeriesCollection(intSeries -
1).MarkerStyle = xlMarkerStyleCircle
xlChart.SeriesCollection(intSeries -
1).MarkerBackgroundColorIndex = 25
xlChart.SeriesCollection(intSeries -
1).MarkerForegroundColorIndex = 25
End If
intSeries = intSeries + 1
Loop
xlChart.HasLegend = False
If dblMin1 > 0 And dblMin1 < 0.6 Then
xlChart.Axes(xlCategory, xlPrimary).MinimumScale =
dblMin1 - 0.1
Else
xlChart.Axes(xlCategory, xlPrimary).MinimumScale = 0.6
End If
xlChart.Axes(xlCategory, xlPrimary).MaximumScale = 1.01
xlChart.Axes(xlValue, xlPrimary).MinimumScale =
Round(dblMin2 - ((dblMax2 - dblMin2) / 2), 0)
xlChart.Axes(xlValue, xlPrimary).MaximumScale =
Round(dblMax2 + ((dblMax2 - dblMin2) / 2), 0)

' Add Averages
intMean = intOverall + 1
If Not rsMean.EOF Then
xlSheet.Cells(intMean, 3) = Format(rsMean!rentalrate,
"Currency")
xlSheet.Cells(intMean, 2) = xlChart.Axes(xlCategory,
xlPrimary).MinimumScale
xlSheet.Cells(intMean, 1) = "Avg. Rental Rate"
intMean = intMean + 1
xlSheet.Cells(intMean, 3) = Format(rsMean!rentalrate,
"Currency")
xlSheet.Cells(intMean, 2) = xlChart.Axes(xlCategory,
xlPrimary).MaximumScale
xlSheet.Cells(intMean, 1) = "Avg. Rental Rate"
intMean = intMean + 1
xlSheet.Cells(intMean, 2) = Format(rsMean!occupancy,
"Percent")
xlSheet.Cells(intMean, 3) = xlChart.Axes(xlValue,
xlPrimary).MinimumScale
xlSheet.Cells(intMean, 1) = "Avg. Occupancy"
intMean = intMean + 1
xlSheet.Cells(intMean, 2) = Format(rsMean!occupancy,
"Percent")
xlSheet.Cells(intMean, 3) = xlChart.Axes(xlValue,
xlPrimary).MaximumScale
xlSheet.Cells(intMean, 1) = "Avg. Occupancy"
intMean = intMean + 1
End If

If intMean <> intOverall Then
xlChart.SeriesCollection.newseries
xlChart.SeriesCollection(intSeries - 1).Name =
xlSheet.Range("A" & intOverall + 1)
xlChart.SeriesCollection(intSeries - 1).Values =
xlSheet.Range("C" & intOverall + 1 & ":C" & intOverall + 2)
xlChart.SeriesCollection(intSeries - 1).XValues =
xlSheet.Range("B" & intOverall + 1 & ":B" & intOverall + 2)
xlChart.SeriesCollection(intSeries - 1).MarkerStyle =
xlNone
xlChart.SeriesCollection(intSeries - 1).ChartType =
xlXYScatterSmoothNoMarkers
xlChart.SeriesCollection(intSeries -
1).Border.ColorIndex = 1
xlChart.SeriesCollection(intSeries -
1).Border.LineStyle = xlDot

intSeries = intSeries + 1
xlChart.SeriesCollection.newseries
xlChart.SeriesCollection(intSeries - 1).Name =
xlSheet.Range("A" & intOverall + 3)
xlChart.SeriesCollection(intSeries - 1).Values =
xlSheet.Range("C" & intOverall + 3 & ":C" & intOverall + 4)
xlChart.SeriesCollection(intSeries - 1).XValues =
xlSheet.Range("B" & intOverall + 3 & ":B" & intOverall + 4)
xlChart.SeriesCollection(intSeries - 1).MarkerStyle =
xlNone
xlChart.SeriesCollection(intSeries - 1).ChartType =
xlXYScatterSmoothNoMarkers
xlChart.SeriesCollection(intSeries -
1).Border.ColorIndex = 1
xlChart.SeriesCollection(intSeries -
1).Border.LineStyle = xlDashDotDot
End If

xlChart.HasTitle = True
xlChart.ChartTitle.Characters.Text = "PROXIMITY MAP ™"
xlChart.ChartTitle.Font.Name = "Centaur"
xlChart.ChartTitle.Font.Size = 12
xlChart.ChartTitle.Font.Bold = True
xlChart.Axes(xlCategory, xlPrimary).HasTitle = True
xlChart.Axes(xlCategory,
xlPrimary).AxisTitle.Characters.Text = "OCCUPANCY"
xlChart.Axes(xlCategory, xlPrimary).AxisTitle.Font.Name =
"Arial"
xlChart.Axes(xlCategory, xlPrimary).AxisTitle.Font.Size =
5
xlChart.Axes(xlCategory, xlPrimary).AxisTitle.Font.Bold =
True
xlChart.Axes(xlCategory, xlPrimary).TickLabels.Font.Name =
"Arial"
xlChart.Axes(xlCategory, xlPrimary).TickLabels.Font.Size =
6
xlChart.Axes(xlCategory, xlPrimary).TickLabels.Font.Bold =
False
xlChart.Axes(xlCategory,
xlPrimary).TickLabels.NumberFormat = "0%"
xlChart.Axes(xlCategory, xlPrimary).HasMajorGridlines =
False
xlChart.Axes(xlValue, xlPrimary).HasTitle = True
xlChart.Axes(xlValue, xlPrimary).AxisTitle.Characters.Text
= "RENTAL RATE"
xlChart.Axes(xlValue, xlPrimary).AxisTitle.Font.Name =
"Arial"
xlChart.Axes(xlValue, xlPrimary).AxisTitle.Font.Size = 5
xlChart.Axes(xlValue, xlPrimary).AxisTitle.Font.Bold =
True
xlChart.Axes(xlValue, xlPrimary).TickLabels.Font.Name =
"Arial"
xlChart.Axes(xlValue, xlPrimary).TickLabels.Font.Size = 6
xlChart.Axes(xlValue, xlPrimary).TickLabels.Font.Bold =
False
xlChart.Axes(xlValue, xlPrimary).TickLabels.NumberFormat =
"$#,##0"
xlChart.Axes(xlValue, xlPrimary).HasMajorGridlines = False
xlChart.PlotArea.Interior.ColorIndex = xlNone
xlChart.PlotArea.Border.ColorIndex = 1

shpCurrent.Width = InchesToPoints(5)
shpCurrent.Height = InchesToPoints(2.5)
xlChart.PlotArea.Left = InchesToPoints(0.16)
xlChart.PlotArea.Top = InchesToPoints(0.25)
xlChart.PlotArea.Width = InchesToPoints(4.5)
xlChart.PlotArea.Height = InchesToPoints(2)
xlChart.ChartTitle.Font.Size = 12

shpCurrent.Borders.Shadow = True
shpCurrent.Borders.OutsideLineStyle = wdLineStyleSingle
shpCurrent.Borders.OutsideLineWidth = wdLineWidth150pt
shpCurrent.Borders.OutsideColorIndex = wdBlack

xlBook.Application.Quit

Set rngGraph = shpCurrent.Range
ActiveDocument.Bookmarks.Add strBookMark & "Delete",
rngGraph
ActiveDocument.Bookmarks(strBookMark & "Delete").Select


End If

ReleaseVariables:

If rsInit.State = adStateOpen Then
rsInit.Close
End If
Set rsInit = Nothing
If rsData.State = adStateOpen Then
rsData.Close
End If
Set rsData = Nothing
If rsMean.State = adStateOpen Then
rsMean.Close
End If
Set rsMean = Nothing

Set xlChart = Nothing
Set xlSheet = Nothing
Set xlBook = Nothing
Set shpCurrent = Nothing
Set objFormat = Nothing

Exit Function

InsertGraphProximityPropertyManager_Error:

MsgBox "Error: " & Err.Number & ": " & Err.Description
Resume Next
End Function

************* Code End ******************************
 
C

Cindy M -WordMVP-

Hi Cak,
I'm using Word as my main application, pulling data from an Access
database, and creating Word tables and embedded Excel charts/graphs
based on the bookmarks present in the document. I've been doing this
fairly successfully until now. The current task is to create the same
excel chart, but with different query criteria, in one Word document,
which results in the looping through of the same procedure and
resulting chart insertion about 25 times. This process works great
the first 5 times, but on the 6th run-through, it blows up. The first
5 times, the excel chart is created as an embedded object within the
Word application. But on the 6th time, it creates a separate Excel
application object and creates the object there. I then get an error
saying: "Microsoft Excel has encountered a problem and needs to close.
We are sorry for the inconvenience." with the error signature:
"AppName: excel.exe AppVer: 10.0.4524.0 ModName: excel.exe ModVer:
10.0.4524.0 Offset: 0014859b". I then get either a "-2147221080 -
Automation Error" or "424 - Object Required". Basically, it's telling
me it's lost the Excel connection.

My thought is that I'm not creating and clearing my instances and
variables correctly - something's not getting released, and it keeps
piling up until it blows up. I've tried to be as explicit as possible
in my declarations.
Click to expand...
Yes, you're thought is indeed on the right track. But the actual problem
isn't really your fault, as far as I've been able to ascertain (with the
support of Microsoft). It is apparently an OLE timing issue, and one
that's inherent when doing "in-place editing". More reliable is to
*always* work in an Excel application window, and then use the .Quit
method of the Excel application (xlBook.Application) to force things to
finish and unload.

To force Word to use an Excel application window, you can either display
field codes, or use DoVerb rather than .ActivateAs + .Activate.

Cindy Meister
INTER-Solutions, Switzerland
http://homepage.swissonline.ch/cindymeister (last update Sep 30 2003)
http://www.mvps.org/word

This reply is posted in the Newsgroup; please post any follow question
or reply in the newsgroup and not by e-mail :)
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Similar Threads

Macro Expert's 1
Change scale of a embedded excel chart in powerpoint using VBA 0
Change Scale In Embedded Xy Scatter Chart In Powerpoint 0
Help needed! Extracting Heading 3 and Contents from a Word Doc to Excel 0
Get last column 2
Adding Chart - Methods Fail 1
Remove Identical words 0
Word macro that can call cells out of Excel for a find and replace 0

Top