Public Sub CreateChart(ByVal strDataSheetName As String, ByVal strChartRPTName As String, ByRef xlbook As Excel.Workbook, ByVal strRPTFileName As String)
Dim xlChartObj As Excel.ChartObject
Dim xlChart As Excel.Chart
Dim xlChartSheet As Excel.Worksheet
Dim xlDataSheet As Excel.Worksheet
Dim rngLastTotalCell As Excel.Range
Dim strLastCellLoc As String
Dim strFirstCellLoc As String
Dim strNextCellLoc As String
Dim strFirstCellLtr As String
Dim strLastCellLtr As String
Set xlDataSheet = xlbook.Worksheets(strDataSheetName)
strFirstCellLoc = xlDataSheet.Cells(2, 6).Address(False, False)
strNextCellLoc = xlDataSheet.Cells(2, 7).Address(False, False)
Set rngLastTotalCell = xlDataSheet.Range(strFirstCellLoc).End(xlDown)
strLastCellLoc = rngLastTotalCell.Address(False, False)
strFirstCellLtr = Mid$(strFirstCellLoc, 1, 1)
strLastCellLtr = Mid$(strNextCellLoc, 1, 1)
strLastCellLoc = Replace$(strLastCellLoc, strFirstCellLtr, strLastCellLtr)
Set xlChartSheet = xlbook.Worksheets.Add(After:=xlbook.Worksheets(xlbook.Worksheets.Count))
xlChartSheet.Name = strChartRPTName
xlChartSheet.Activate
Set xlChartObj = xlChartSheet.ChartObjects.Add(Left:=100, Width:=375, Top:=75, Height:=225)
xlChartObj.Name = strChartRPTName
xlChartObj.Activate
Set xlChart = xlChartObj.Chart
xlApp.ActiveChart.SetSourceData Source:=xlDataSheet.Range(strFirstCellLoc & ":" & strLastCellLoc)
xlApp.ActiveChart.ChartType = xl3DPieExploded
xlApp.ActiveChart.ChartArea.Select
xlApp.ActiveChart.Location Where:=xlLocationAsNewSheet
xlApp.ActiveChart.SizeWithWindow = True
xlApp.ActiveChart.PlotBy = xlColumns
xlApp.ActiveChart.Legend.Select
xlApp.ActiveChart.Legend.Position = xlLegendPositionBottom
xlApp.ActiveChart.Legend.Shadow = True
xlApp.ActiveChart.HasTitle = True
xlApp.ActiveChart.ChartTitle.Select
xlApp.ActiveChart.ChartTitle.Caption = strChartRPTName
xlApp.ActiveChart.Elevation = 30
xlApp.ActiveChart.ChartArea.Fill.ForeColor.SchemeColor = 49
xlApp.ActiveChart.ChartArea.Fill.BackColor.SchemeColor = 23
xlApp.ActiveChart.ChartArea.Fill.TwoColorGradient 1, 1
xlApp.ActiveChart.PlotArea.Select
xlApp.ActiveChart.PlotArea.Border.Weight = xlThin
xlApp.ActiveChart.PlotArea.Border.LineStyle = xlNone
xlApp.ActiveChart.PlotArea.Interior.ColorIndex = xlNone
xlApp.ActiveChart.PlotArea.Fill.Visible = False
xlApp.ActiveChart.ApplyDataLabels AutoText:=True, LegendKey:=False, _
HasLeaderLines:=True, ShowSeriesName:=False, ShowCategoryName:=True, _
ShowValue:=True, ShowPercentage:=True, ShowBubbleSize:=False, Separator:=" : "
xlApp.ActiveChart.SeriesCollection(1).DataLabels.Select
Selection.AutoScaleFont = True
With Selection.Font
.Name = "Verdana"
.FontStyle = "Bold"
.Size = 12
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = 2
.Background = xlAutomatic
End With
'*** Position the DataLabels
xlApp.ActiveChart.SeriesCollection(1).Points(1).DataLabel.Select
Selection.Left = 523
Selection.Top = 91
xlApp.ActiveChart.SeriesCollection(1).Points(2).DataLabel.Select
Selection.Left = 777
Selection.Top = 121
xlApp.ActiveChart.SeriesCollection(1).Points(3).DataLabel.Select
Selection.Left = 936
Selection.Top = 238
xlApp.ActiveChart.SeriesCollection(1).Points(4).DataLabel.Select
Selection.Left = 807
Selection.Top = 466
xlApp.ActiveChart.SeriesCollection(1).Points(5).DataLabel.Select
Selection.Left = 519
Selection.Top = 519
xlApp.ActiveChart.SeriesCollection(1).Points(6).DataLabel.Select
Selection.Left = 327
Selection.Top = 485
xlApp.ActiveChart.SeriesCollection(1).Points(7).DataLabel.Select
Selection.Left = 72
Selection.Top = 348
xlApp.ActiveChart.SeriesCollection(1).Points(8).DataLabel.Select
Selection.Left = 239
Selection.Top = 114
ActiveChart.ChartTitle.Select
ActiveChart.ChartTitle.AutoScaleFont = True
With Selection.Font
.Name = "Verdana"
.FontStyle = "Bold"
.Size = 16
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = 2
.Background = xlAutomatic
End With
xlChartSheet.Delete
Sheets("Chart1").Select
Sheets("Chart1").Name = strChartRPTName
If Not gobjFSO.FileExists(strRPTFileName) Then
xlbook.SaveAs strRPTFileName, xlExcel9795
Else
xlbook.Save
End If
End Sub