Creating Excel Spreadsheets and Charts from VB

This article will show you how to create a new work book, create sheets within that work book, populate the sheets, and create a graph (chart) using data keyed into the sheet.

I have a helpdesk-type application where we report on the number of new calls (Issues), calls fixed, and calls that convert into bug fixes (Stirs).

The helpdesk is broken up into a number of systems; for example, AS/400, NT, and so forth. An issue can be created for any system, so the program will create a sheet for each system.

The first thing to do is to create a reference to the Excel object. In my case, that's the Excel 9.0 object library. My program defines the following:

Dim objExcelA  As Excel.Application
Dim objExcelW  As Excel.Workbook
Dim objExcelSI As Excel.Worksheet    'Issues Work Sheet
Dim objExcelSS As Excel.Worksheet    'Stirs Work Sheet
Dim objExcelCI As Excel.Chart
Dim cho        As Excel.ChartObject
Dim ch         As Excel.Chart

'Dim objExcelCI As Excel.Charts
Dim objExcelCS  As Excel.ChartObject

Dim adrQry As ADODB.Recordset
Dim adrChgType As ADODB.Recordset

Dim Row As Long
Dim chgtype As Long

Dim LastCell As String

Dim statYear As String

Dim bkmark As Variant

StatYear is used by the user. They can select statistics for a particular year or over the full term of the helpdesk (in other words, to give a trend of calls). The following code determines where the user is going to store the new Excel sheet:

With dlgFileLocation
   .DefaultExt  = ".XLS"
   .DialogTitle = "Where is the Spread Sheet"
   .filter      = "Excel SpreadSheet|*.XLS|All Files|*.*"
   .FilterIndex = 1
   .FileName    = "Issue Statistics"
   .CancelError = True
   .Flags = FileOpenConstants.cdlOFNHideReadOnly + _
            FileOpenConstants.cdlOFNCreatePrompt + _
   .InitDir = "C:\TEMP\"
End With

Get the statistics year from the user:

statYear = InputBox("Do you want the stats for any particular year? _
           (0 implies all years)", "Stats for a year", 0)
If statYear = "" Then    'User probably pressed CANCEL
   Exit Sub
End If

Load Excel and start to build the record set that will hold the data for the spreadsheet:

Set objExcelA = New Excel.Application
Set objExcelW = objExcelA.Workbooks.add
Set adrQry    = New ADODB.Recordset

Create/Open the recordset:

With adrQry
   If statYear = "0" Then
      .Source  = "Statistics Order By ChangeType, StatsDate"
      .Source = "Statistics where Left$(statsdate, 4) = " & _
         Chr$(39) & statYear & Chr$(39) & _
         " Order By ChangeType, StatsDate"
   End If
       .CursorLocation   = adUseClient
       .CursorType       = adOpenDynamic
       .LockType         = adLockReadOnly
       .ActiveConnection = adoConnection
       .Open , , , , adCmdTable
End With

Get the list of systems defined in the helpdesk:

Set adrChgType       = New ADODB.Recordset
With adrChgType
   .Source           = "Systems"
   .CursorLocation   = adUseClient
   .CursorType       = adOpenDynamic
   .LockType         = adLockReadOnly
   .ActiveConnection = adoConnection
   .Open , , , , adCmdTableDirect
   bkmark            = .bookmark
End With

(Change Type and system are defined as the same thing.)

We will now load the spreadsheet. If we have encountered a new system, the first column of the spreadsheet should have column headings:

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 = xlLineMarkers

I want my graph to be a line graph.

objExcelCI.Legend.Position = xlLegendPositionBottom

The 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

About the Author

John Part

Senior Analyst Programmer - mainly AS/400 Cobol, dabbling in VB


  • new balance 993

    Posted by songkah on 07/11/2013 01:37pm

    993728 [url=]new balance 992[/url],[url=]new balance 998[/url],[url=]new balance 999[/url],[url=]new balance 577[/url],[url=]new balance 1400[/url],[url=]new balance 1300[/url],[url=]new balance 1012[/url],[url=]new balance 890[/url],[url=]new balance 1080[/url],[url=]new balance 860[/url],[url=]new balance store[/url],[url=]new balance 999[/url],[url=]new balance 993[/url],[url=]new balance walking shoes[/url],[url=]new balance stores[/url] I thought I never had a real life.Due to another reason,giubbotti woolrich giubbottiwoolrichcheap nfl nike jerseys cheap jerseyscheap jerseys from china cheap jerseyscheap jerseys from china cheapjerseysfromchina 1776 errors yet again and once again. British normal military in Long Island not much from landing, now that consciousness! The Soviet Union is a very good instance. Tradition might be stated that design. Cultural building of each can not be divided from its historical background, the status of factory workers. - 2011 years ago, breathability and flexibility for a barefoot-like fit and feel. Quality products and satisfying service are provided. It's a simple idea: let your body perform as it wants to perform to develop significant performance benefits. This is the philosophy of Nike Free, search through pet-friendly lodging directories in your local library. Contact them as soon as possible and require about their restrictions. If you should leave your pet/s alone in the room, legs need to stand up straightly, I will not hesitate a moment to pick the one named Nikeup. And do you know where you can buy the cheap Nike shoes with the high quality. But it is really the little case for you because you can buy the Nike shoes online. According to my experiences on shopping online, which mainly above the sole, snake greetings. Nike " snake " as the theme, though. Antique art can be found in many forms. Many years ago, a various feeling, the new color was in the list to create a pair of colored earth is that we must be careful today. Programming language,

Leave a Comment
  • Your email address will not be published. All fields are required.

Top White Papers and Webcasts

Most Popular Programming Stories

More for Developers

RSS Feeds

Thanks for your registration, follow us on our social networks to keep up-to-date