• Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 534
  • Last Modified:

Making a chart in Excel with Visual Basic 6

I have the following code for putting data into an excel workbook.  However, is there a way to plot the data and then create a chart?

Set ApExcel = CreateObject("Excel.application") 'Creates an object
ApExcel.Visible = True ' So you can see Excel

'ApExcel.Workbooks.Open "\\2000server\JJDP\Referral Database\JJDP Sheets\Attendance Sheet.xls"
ApExcel.Workbooks.Open "C:\Registered Statistic Sheet.xls"

    ApExcel.Workbooks("Registered Statistic Sheet.xls").Sheets("Sheet1").Cells(4, 5).Formula = Com(1)
    ApExcel.Workbooks("Registered Statistic Sheet.xls").Sheets("Sheet1").Cells(4, 6).Formula = Com(2)
    ApExcel.Workbooks("Registered Statistic Sheet.xls").Sheets("Sheet1").Cells(4, 7).Formula = Com(3)
1 Solution
Here is the sample code
Do While Not adrQry.EOF
   If chgtype <> adrQry.Fields("ChangeType") Then
      adrChgType.Find "SystemId = " & adrQry.Fields("ChangeType"), _
                                  , adSearchForward, bkmark
      Set objExcelSI  = objExcelW.Worksheets.add
      objExcelSI.Name = adrChgType.Fields("ChangeType") & " - Issues"
      chgtype         = adrQry.Fields("ChangeType")
      Set objExcelSS  = objExcelW.Worksheets.add
      objExcelSS.Name = adrChgType.Fields("System") & " - Stirs"
      objExcelSI.Cells(1, 1).Value = "Year / Week"
      objExcelSI.Cells(1, 2).Value = "Curent Outstanding"
      objExcelSI.Cells(1, 3)       = "New Issues This Week"
      objExcelSI.Cells(1, 4)       = "Completed Issues This Week"
      objExcelSS.Cells(1, 1).Value = "Year / Week"
      objExcelSS.Cells(1, 2).Value = "Outstanding Stirs"
      objExcelSS.Cells(1, 3).Value = "New Stirs This Week"
      objExcelSS.Cells(1, 4)       = "Completed Stirs This Week"

      Row = 2
      Set objExcelCI = objExcelW.ActiveChart
      objExcelCI.Name = adrChgType.Fields("System") & " - Issues Chart"
   End If
We have now created a two new sheets: one for the issues (SI) and one for the Stirs/bug fixes (SS). We have also created a chart sheet (the chart sheet will only show a graph of the issues). We will now load the data into the sheet:

objExcelSI.Cells(Row, 1).Value = adrQry.Fields("StatsDate")
objExcelSI.Cells(Row, 2).Value = adrQry.Fields("Curent Outstanding")
objExcelSI.Cells(Row, 3) = adrQry.Fields("New Issues This Week")
objExcelSI.Cells(Row, 4) = adrQry.Fields("Completed Issues This Week")
objExcelSS.Cells(Row, 1).Value = adrQry.Fields("StatsDate")
objExcelSS.Cells(Row, 2).Value = adrQry.Fields("Outstanding Stirs _
                                                This Week")

If we have encounted the end of the recordset or the system/change type has changed, we need to build the chart/graph:

If adrQry.EOF Then
      LastCell = "D" & Mid$(Str$(Row), 2)
      objExcelCI.SetSourceData objExcelSI.Range("a1:" & _
                                                LastCell), _
      objExcelCI.ChartType       = xlLineMarkers
      objExcelCI.Legend.Position = xlLegendPositionBottom
      objExcelCI.HasTitle        = True
      objExcelCI.ChartTitle.Text = objExcelCI.Name
      If chgtype <> adrQry.Fields("ChangeType") Then
         LastCell = "D" & Mid$(Str$(Row), 2)
         objExcelCI.SetSourceData objExcelSI.Range("a1:" & _
                                                   LastCell), _
         objExcelCI.ChartType       = xlLineMarkers
         objExcelCI.Legend.Position = xlLegendPositionBottom
         objExcelCI.HasTitle        = True
         objExcelCI.ChartTitle.Text = objExcelCI.Name
      End If
   End If
   Row = Row + 1
The variable Row is incremented as we write a new row, so the line LastCell = "D" & Mid$(Str$(Row), 2) sets LASTCELL to something like D10.

objExcelCI.SetSourceData objExcelSI.Range("a1:" & LastCell), _
This line tells the chart the range of the data it is to use.

objExcelCI.ChartType = xlLineMarkersI want my graph to be a line graph.

objExcelCI.Legend.Position = xlLegendPositionBottomThe legend is to go at the bottom of the screen:

objExcelCI.HasTitle        = True
objExcelCI.ChartTitle.Text = objExcelCI.Name
The chart has a title and the title should be the same as the issues spreadsheet that created it.

Time to close everything now:

objExcelA.DisplayAlerts = False
objExcelW.SaveAs dlgFileLocation.FileName


Set objExcelA  = Nothing
Set objExcelW  = Nothing
Set objExcelSI = Nothing
Set objExcelSS = Nothing
Set objExcelCI = Nothing
Set objExcelCS = Nothing

If adrQry.State     = adStateOpen Then
End If
If adrChgType.State = adStateOpen Then
End If

Set adrQry      = Nothing
Set adrChgType  = Nothing

Me.MousePointer = vbNormal

Exit Sub
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

Join & Write a Comment

Featured Post

Never miss a deadline with monday.com

The revolutionary project management tool is here!   Plan visually with a single glance and make sure your projects get done.

Tackle projects and never again get stuck behind a technical roadblock.
Join Now