J
Joe
I am receiving the following error during macro execution. The error occurs
only when the macro is ran through Excel 2007. Asking the users to rollback
to Excel 2003 will not be an option soon. Thanks.
Regards,
Joe
ERROR MESSAGE:
Run-time error '-2147417847 (80010108)':
Automation error
The object invoked has disconnected from its clients.
REFERENCE LIBRARIES BEING USED AT RUNTIME:
Visual Basic For Application
Microsoft Excel 12.0 Object Library
Microsfot Office 12.0 Object Library
OLE Automation
LINE OF CODE CAUSING THE ERROR:
oChartSkel.Sheets(x).Copy After:=oThisMgrChartBook.Sheets(1)
MACRO CODE:
Sub GenerateCharts(Optional oMacroParams As Object = Nothing)
Dim oSheet As Worksheet, lngLastRow As Long, rngTestRange As Range,
oChartSkel As Workbook, oThisMgrChartBook As Workbook
Dim oCurrentChartSheet As Worksheet, oMgrNotebook As Workbook, iStatusDateCol
'On Error Resume Next
Set oMgrNotebook = ThisWorkbook
If oMacroParams Is Nothing Then Exit Sub
'make sure chartgen sheet exists
If Not SheetExists(CHARTGEN_SHEETNAME) Then Exit Sub
'set a reference to chartgen sheet
Set oSheet = ThisWorkbook.Sheets(CHARTGEN_SHEETNAME)
If oSheet Is Nothing Then Exit Sub
'find the last row
lngLastRow = oSheet.Cells.SpecialCells(xlCellTypeLastCell).Row
'if there is no data past the title block then bail out
If lngLastRow < 7 Then Exit Sub
'open chart skeleton workbook
Set oChartSkel = Workbooks.Open(Filename:=oMacroParams.ChartSkel,
ReadOnly:=True)
If oChartSkel Is Nothing Then Exit Sub
'create a new workbook to put the charts in
Set oThisMgrChartBook = Workbooks.Add
'loop through chartgen sheet and make charts for each account
Set rngTestRange = oSheet.Cells(6, 1)
Do
Set rngTestRange = rngTestRange.Offset(1, 0)
'check for start of new cost account
If Not IsEmpty(rngTestRange.Value) Then
sAccount = Left$(Mid(rngTestRange, 8, InStr(1, rngTestRange, "
") - 8), 31)
For x = 1 To oChartSkel.Sheets.Count
'copy chart sheets from skel to this cam's chart notebook
'execution of the following line cause the Automation Error
oChartSkel.Sheets(x).Copy After:=oThisMgrChartBook.Sheets(1)
Set oCurrentChartSheet = oThisMgrChartBook.ActiveSheet
sSourceChartName = ActiveSheet.Name
With oCurrentChartSheet
.Name = sAccount & "_" & oChartSkel.Sheets(x).Name
.Range("A49") = oMacroParams.ProgramDescription
.Range("A50") = oMacroParams.StatusDateLabel
.Range("A51") = rngTestRange
End With
'moving to variable calendar range, so copy labels to charts
oSheet.Range("E6:R6").Copy
oCurrentChartSheet.Range("B51").PasteSpecial xlPasteValues
'copy from source to this chart's data
With oSheet
.Range(.Cells(rngTestRange.Row + 1, 5),
..Cells(rngTestRange.Row + 16, 20)).Copy
End With
'oSheet.Range("E" & rngTestRange.Row + 1 & ":T" &
rngTestRange.Row + 16).Copy
oCurrentChartSheet.Range("B52").PasteSpecial xlPasteValues
'update acwp, bcwp series
iStatusDateCol = GetStatusDateCol(oCurrentChartSheet)
Select Case sSourceChartName
Case "EarnedValue"
With oCurrentChartSheet.ChartObjects("Chart 1").Chart
.SeriesCollection(2).Values = "='" &
oCurrentChartSheet.Name & "'!R31C3:R31C" & iStatusDateCol & ""
.SeriesCollection(3).Values = "='" &
oCurrentChartSheet.Name & "'!R32C3:R32C" & iStatusDateCol & ""
End With
'Apply last chart column to the CPI, SPI & TCPI series
on CPI / SPI chart.
iStatusDateCol = iStatusDateCol + 16
With oCurrentChartSheet.ChartObjects("Chart 2").Chart
.SeriesCollection(1).Values = "='" &
oCurrentChartSheet.Name & "'!R29C19:R29C" & iStatusDateCol & ""
.SeriesCollection(2).Values = "='" &
oCurrentChartSheet.Name & "'!R30C19:R30C" & iStatusDateCol & ""
.SeriesCollection(3).Values = "='" &
oCurrentChartSheet.Name & "'!R31C19:R31C" & iStatusDateCol & ""
End With
End With
Case "Workforce"
With oCurrentChartSheet.ChartObjects("Chart 2").Chart
.SeriesCollection(2).Values = "='" &
oCurrentChartSheet.Name & "'!R32C3:R32C" & iStatusDateCol - 1 & ""
End With
End Select
Next x
End If
Loop Until rngTestRange.Row = lngLastRow
'delete extra sheets
oThisMgrChartBook.Sheets(Array("Sheet1", "Sheet2", "Sheet3")).Delete
'save the chart notebook
Dim sChartNotebookName As String
sChartNotebookName = Left(oMgrNotebook.FullName,
Len(oMgrNotebook.FullName) - 4) & "_chart.xls"
oThisMgrChartBook.SaveAs Filename:=sChartNotebookName
'opening the chart skel made it active so re-active the mrg notebook
oMgrNotebook.Activate
'delete the chartgen sheet
oSheet.Delete
End Sub
only when the macro is ran through Excel 2007. Asking the users to rollback
to Excel 2003 will not be an option soon. Thanks.
Regards,
Joe
ERROR MESSAGE:
Run-time error '-2147417847 (80010108)':
Automation error
The object invoked has disconnected from its clients.
REFERENCE LIBRARIES BEING USED AT RUNTIME:
Visual Basic For Application
Microsoft Excel 12.0 Object Library
Microsfot Office 12.0 Object Library
OLE Automation
LINE OF CODE CAUSING THE ERROR:
oChartSkel.Sheets(x).Copy After:=oThisMgrChartBook.Sheets(1)
MACRO CODE:
Sub GenerateCharts(Optional oMacroParams As Object = Nothing)
Dim oSheet As Worksheet, lngLastRow As Long, rngTestRange As Range,
oChartSkel As Workbook, oThisMgrChartBook As Workbook
Dim oCurrentChartSheet As Worksheet, oMgrNotebook As Workbook, iStatusDateCol
'On Error Resume Next
Set oMgrNotebook = ThisWorkbook
If oMacroParams Is Nothing Then Exit Sub
'make sure chartgen sheet exists
If Not SheetExists(CHARTGEN_SHEETNAME) Then Exit Sub
'set a reference to chartgen sheet
Set oSheet = ThisWorkbook.Sheets(CHARTGEN_SHEETNAME)
If oSheet Is Nothing Then Exit Sub
'find the last row
lngLastRow = oSheet.Cells.SpecialCells(xlCellTypeLastCell).Row
'if there is no data past the title block then bail out
If lngLastRow < 7 Then Exit Sub
'open chart skeleton workbook
Set oChartSkel = Workbooks.Open(Filename:=oMacroParams.ChartSkel,
ReadOnly:=True)
If oChartSkel Is Nothing Then Exit Sub
'create a new workbook to put the charts in
Set oThisMgrChartBook = Workbooks.Add
'loop through chartgen sheet and make charts for each account
Set rngTestRange = oSheet.Cells(6, 1)
Do
Set rngTestRange = rngTestRange.Offset(1, 0)
'check for start of new cost account
If Not IsEmpty(rngTestRange.Value) Then
sAccount = Left$(Mid(rngTestRange, 8, InStr(1, rngTestRange, "
") - 8), 31)
For x = 1 To oChartSkel.Sheets.Count
'copy chart sheets from skel to this cam's chart notebook
'execution of the following line cause the Automation Error
oChartSkel.Sheets(x).Copy After:=oThisMgrChartBook.Sheets(1)
Set oCurrentChartSheet = oThisMgrChartBook.ActiveSheet
sSourceChartName = ActiveSheet.Name
With oCurrentChartSheet
.Name = sAccount & "_" & oChartSkel.Sheets(x).Name
.Range("A49") = oMacroParams.ProgramDescription
.Range("A50") = oMacroParams.StatusDateLabel
.Range("A51") = rngTestRange
End With
'moving to variable calendar range, so copy labels to charts
oSheet.Range("E6:R6").Copy
oCurrentChartSheet.Range("B51").PasteSpecial xlPasteValues
'copy from source to this chart's data
With oSheet
.Range(.Cells(rngTestRange.Row + 1, 5),
..Cells(rngTestRange.Row + 16, 20)).Copy
End With
'oSheet.Range("E" & rngTestRange.Row + 1 & ":T" &
rngTestRange.Row + 16).Copy
oCurrentChartSheet.Range("B52").PasteSpecial xlPasteValues
'update acwp, bcwp series
iStatusDateCol = GetStatusDateCol(oCurrentChartSheet)
Select Case sSourceChartName
Case "EarnedValue"
With oCurrentChartSheet.ChartObjects("Chart 1").Chart
.SeriesCollection(2).Values = "='" &
oCurrentChartSheet.Name & "'!R31C3:R31C" & iStatusDateCol & ""
.SeriesCollection(3).Values = "='" &
oCurrentChartSheet.Name & "'!R32C3:R32C" & iStatusDateCol & ""
End With
'Apply last chart column to the CPI, SPI & TCPI series
on CPI / SPI chart.
iStatusDateCol = iStatusDateCol + 16
With oCurrentChartSheet.ChartObjects("Chart 2").Chart
.SeriesCollection(1).Values = "='" &
oCurrentChartSheet.Name & "'!R29C19:R29C" & iStatusDateCol & ""
.SeriesCollection(2).Values = "='" &
oCurrentChartSheet.Name & "'!R30C19:R30C" & iStatusDateCol & ""
.SeriesCollection(3).Values = "='" &
oCurrentChartSheet.Name & "'!R31C19:R31C" & iStatusDateCol & ""
End With
End With
Case "Workforce"
With oCurrentChartSheet.ChartObjects("Chart 2").Chart
.SeriesCollection(2).Values = "='" &
oCurrentChartSheet.Name & "'!R32C3:R32C" & iStatusDateCol - 1 & ""
End With
End Select
Next x
End If
Loop Until rngTestRange.Row = lngLastRow
'delete extra sheets
oThisMgrChartBook.Sheets(Array("Sheet1", "Sheet2", "Sheet3")).Delete
'save the chart notebook
Dim sChartNotebookName As String
sChartNotebookName = Left(oMgrNotebook.FullName,
Len(oMgrNotebook.FullName) - 4) & "_chart.xls"
oThisMgrChartBook.SaveAs Filename:=sChartNotebookName
'opening the chart skel made it active so re-active the mrg notebook
oMgrNotebook.Activate
'delete the chartgen sheet
oSheet.Delete
End Sub