Excel Automation using VB6 Pro

[JDM6763]

I'm having an issue generating a chart as a full sheet using Excel automation with VB 6. I don't have a problem with generating the datasheets, but my chart needs to be on it's own sheet, not as an object on a worksheet. My chart is also based on data on another sheet.

Would anyone having sample code for doing this or be able to point me in the right direction? or maybe look at some of my code snippets?

Thanks in advance,
Jim

 

[Norie]

Jim

How can we look at your code snippets if you don't post them?O

 

[JDM6763]

Jim

How can we look at your code snippets if you don't post them?O

I wanted to make sure that Excel Automation with VB6 discussion was ok for this forum before posting anything in too much detail. When reading the rules it sounded as though this was an Excel/VBA only forum.

Jim

 

[RoryA]

Assuming a chart variable called cht which you have added to a sheet, you can use:

Set cht = cht.Location(xllocationasnewsheet)

assuming you have a reference set to the Excel library. If you are late binding then you need to use 1 instead of xllocationasnewsheet.
HTH

 

[JDM6763]

Ok. Here is what I've done. The code below will create a new worksheet placing it as the last worksheet in a workbook. It will then create a chart within a chart object (container) then convert the Chart object into a new ChartSheet then resizing it to the window, along with other formatting. I'm sure there is a better way to do this but hopefully something in here will save someone a lot of time and grief.

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