• Create BookmarkCreate Bookmark
  • Create Note or TagCreate Note or Tag
  • PrintPrint
Share this Page URL
Help

Chapter 14. Charting XML Data > The Solution Code

The Solution Code

This solution contains one main routine, which calls one of two other routines dedicated to importing the XML data, depending on the version of Excel in use. All three routines are shown in Listing 14.2. The code is a bit lengthy. After the full listing, sections of code functionality are explained.

Listing 14.2. The solution code

						Sub create_charts()
On Error GoTo err_end
Dim l, t, w, h
Dim chart_top
Dim plotwidth, plotheight
Dim date_min, date_max
Dim date_window As String
Dim date_format As Integer
Dim end_row As Integer
Dim row_resize As Integer
Dim chart_count As Integer
Dim this_city As String
Dim this_program As String
Dim city_start_row As Integer
Dim city_end_row As Integer
Dim new_rows As Integer
Dim cur_row As Integer
Dim cur_col As Integer
Dim chart_title As String
' turn off screen activity
Application.ScreenUpdating = False
' Store chart size values
With Worksheets("Chart Setup")
  ' left, top, width, height of the charts
  l = .Cells(6, 1)
  t = .Cells(7, 1)
  w = .Cells(8, 1)
  h = .Cells(9, 1)
  ' plot width and height
  plotwidth = .Cells(12, 1)
  plotheight = .Cells(13, 1)
End With
' turn off alerts
Application.DisplayAlerts = False
' feedback to user
Application.StatusBar = "Setting up Worksheets"
' delete the Charts and Data worksheets -
' insert new ones
With ActiveWorkbook
  On Error Resume Next
  .Sheets("Charts").Delete
  .Sheets("Data").Delete
  ' reset error trap
  On Error GoTo err_end
  Worksheets.Add.Move after:=Worksheets(Worksheets.Count)
  ActiveSheet.Name = "Charts"
  Worksheets.Add.Move after:=Worksheets(Worksheets.Count)
  ActiveSheet.Name = "Data"
End With
' feedback to user
Application.StatusBar = "Reading Grades Data"
' read grade data from grades.xml, and insert into Data sheet
' if this is Excel 2003 or greater, then use built-in XML methods
' else if an earlier version, use MSXML
If Application.Version >= 11 Then
   read_in_xml_grades
Else
   msxml_read_in_xml_grades
End If
' prepare header message
Sheets("Data").Activate
' use SpecialCells to find the last data row
Selection.SpecialCells(xlLastCell).Select
end_row = ActiveCell.Row - 1
' convert dates from text to real dates
For date_format = 2 To end_row
  Cells(date_format, 5) = CDate(Cells(date_format, 5))
Next date_format
' use Min and Max to get the earliest and latest dates
date_min = _
    Application.Min(Range(Cells(2, 5), Cells(end_row, 5)))
date_max = _
    Application.Max(Range(Cells(2, 5), Cells(end_row, 5)))
' date_window variable holds the complete header message
date_window = "For the period " & _
   Format(date_min, "mm/dd/yy") & " - " & _
   Format(date_max, "mm/dd/yy")
' feedback to user
Application.StatusBar = "Setting up Header"
' prepare the header on the Charts worksheet
Worksheets("Charts").Activate
With ActiveSheet.PageSetup
    .LeftHeader = "&""Arial,Bold""&14Program Results" & _
        Chr$(13) & "by Region and Office"
    .RightHeader = date_window
End With
' to prevent charts from straddling page breaks,
' resize the sheet rows to the same height as the charts
For row_resize = 1 To 100
  ActiveSheet.Rows(row_resize).RowHeight = t
Next
' remove grid lines from the Charts sheet
ActiveWindow.DisplayGridlines = False
' sort the data by program, region, and city (columns A, B, C)
Sheets("Data").Activate
Range("A1:E" & end_row).Sort Key1:=Range("A2"), _
    Order1:=xlAscending, Key2:=Range("B2"), _
    Order2:=xlAscending, Key3:=Range("C2"), _
    Order3:=xlAscending, Header:=xlYes
chart_count = 0
' get first city and program
Cells(2, 3).Activate
this_city = ActiveCell
this_program = ActiveCell.Offset(0, -2)
city_start_row = ActiveCell.Row
' loop down through worksheet until no more data
While ActiveCell <> ""
   ' loop down while the city and the program are the same
   While ActiveCell = this_city And _
       ActiveCell.Offset(0, -2) = this_program
       ActiveCell.Offset(1, 0).Activate
   Wend
   ' now on a new city and/or new program,
   ' store ending row of previous city-program combo, and
   ' store new city and program names
   city_end_row = ActiveCell.Offset(-1, 0).Row
   this_city = ActiveCell
   this_program = ActiveCell.Offset(0, -2)
   ' increment region count
   chart_count = chart_count + 1
   ' feedback to user
   Application.StatusBar = "Processing data set " & chart_count
   ' put in 10 blank rows, this creates space for calculations
   For new_rows = 1 To 10
      ActiveCell.EntireRow.Insert
   Next new_rows
   ' XML import lands data as text, needs to be converted
   ' to number format so calculations will work
   Range(ActiveCell, _
     Cells(ActiveCell.Row + 8, ActiveCell.Column + 1)) _
    .NumberFormat = "##"
   ' insert formulas
   ' for each break in data (a change in the city-program combo)
   ' a summary section is created
   ' The charts plot the percentage of total for each grade, so
   ' a separate count is needed for each grade (A, B, C, D),
   ' and a count of the total is needed.
   ' The CountIf function is used
   ' for calculating counts based on grades.
   ' Then a calculation returns each grade's
   ' percentage of the total
   ' Step 1 - put in labels
   With ActiveCell
     .Value = "A"
     .Offset(1, 0).Value = "B"
     .Offset(2, 0).Value = "C"
     .Offset(3, 0).Value = "D"
     .Offset(4, 0).Value = "Total"
     .Offset(5, 0).Value = "A"
     .Offset(6, 0).Value = "B"
     .Offset(7, 0).Value = "C"
     .Offset(8, 0).Value = "D"
   End With
   ' Step 2 - Count by Grade
   ActiveCell.Offset(0, 1).Formula = _
       "=CountIf(D" & city_start_row & _
          ":D" & city_end_row & ",""A"")"
   ActiveCell.Offset(1, 1).Formula = _
       "=CountIf(D" & city_start_row & _
          ":D" & city_end_row & ",""B"")"
   ActiveCell.Offset(2, 1).Formula = _
       "=CountIf(D" & city_start_row & _
          ":D" & city_end_row & ",""C"")"
   ActiveCell.Offset(3, 1).Formula = _
       "=CountIf(D" & city_start_row & _
          ":D" & city_end_row & ",""D"")"
   ActiveCell.Offset(4, 1).Formula = _
       "=Sum(D" & city_end_row + 1 & _
           ":D" & city_end_row + 4 & ")"
   ' Step 3 - Grade Percentage of Total
   ActiveCell.Offset(5, 1).Formula = _
       "=D" & city_end_row + 1 & "/D" & city_end_row + 5
   ActiveCell.Offset(6, 1).Formula = _
       "=D" & city_end_row + 2 & "/D" & city_end_row + 5
   ActiveCell.Offset(7, 1).Formula = _
       "=D" & city_end_row + 3 & "/D" & city_end_row + 5
   ActiveCell.Offset(8, 1).Formula = _
       "=D" & city_end_row + 4 & "/D" & city_end_row + 5
   ' get the active cell's coordinates before the next operation
   cur_row = ActiveCell.Row
   cur_col = ActiveCell.Column
   ' format as percentage
   Range(ActiveCell.Offset(5, 1), _
        ActiveCell.Offset(8, 1)).Select
   Selection.NumberFormat = "0%"
   ' restore to the real active cell, the format operation just
   ' completed left the active cell on an offset cell
   Cells(cur_row, cur_col).Select
   ' now add the chart for this site
   ' first prepare the chart title of the form . . .
   ' Program at Region-City
   chart_title = ActiveCell.Offset(-1, -2) & " at " & _
     ActiveCell.Offset(-1, -1) & "-" & ActiveCell.Offset(-1, 0)
   Sheets("Charts").Activate
   ' need to preserve t as incremental value, so use
   ' chart_top variable for the actual top value of each chart
   If chart_count = 1 Then
     chart_top = 1
   Else
     chart_top = t * chart_count - t
   End If
   ' feedback to user
   Application.StatusBar = "Creating Chart # " & chart_count
   ' add chart object using established size and position
   ActiveSheet.ChartObjects.Add(l, chart_top, w, h).Select
   Application.CutCopyMode = False
   ' The ChartWizard method is used to produce the chart -
   ' The data source is set to the summary section created on
   ' the Data sheet. The chart type, legend, and title
   ' are all set here.
   ActiveChart.ChartWizard Source:= _
      Range("Data!C" & cur_row + 5 & ":Data!D" & cur_row + 8), _
      Gallery:=xl3DPie, Format:=7, PlotBy:=xlColumns, _
      CategoryLabels:=1, SeriesLabels:=0, HasLegend:=1, _
      Title:=chart_title
   ActiveSheet.ChartObjects(chart_count).Activate
   ' the inner plot area is resized . . .
   ActiveChart.PlotArea.Select
   Selection.Width = plotwidth
   Selection.Height = plotheight
   ' this releases the chart and reactivates the workbook window
   Windows(ActiveWorkbook.Name).Activate
   ' back to the Data sheet - where processing was last left,
   ' just above the summary section
   Sheets("Data").Activate
   Cells(cur_row, cur_col).Select
   ' get past the 10 rows of the summary section
   ActiveCell.Offset(10, 0).Activate
   ' starting on next chart, store start row
   city_start_row = ActiveCell.Row
Wend ' end of outer loop
' at end, leave user viewing charts
Sheets("Charts").Activate
Cells(1, 1).Activate
Application.StatusBar = ""
MsgBox "done"
Exit Sub
err_end:
MsgBox Err.Description
End Sub
Sub read_in_xml_grades()
  Dim gr_map As XmlMap
  Dim xmlfile As String
  Dim xmlschema As String
  Dim map_delete As Integer
  If ActiveWorkbook.XmlMaps.Count > 0 Then
    For map_delete = ActiveWorkbook.XmlMaps.Count To 1 Step -1
      ActiveWorkbook.XmlMaps(map_delete).Delete
    Next
  End If
  xmldata = ActiveWorkbook.Path & "\grades.xml"
  xmlschema = ActiveWorkbook.Path & "\grades.xsd"
  ' create a map based on the schema file
  Set gr_map = ActiveWorkbook.XmlMaps.Add(xmlschema, "Grades")
  ' import XML into Data worksheet
  ActiveWorkbook.XmlImport xmldata, gr_map, True, "Data!A1"
  ' import treats data as list, so apply unlist method
  Worksheets("Data").ListObjects(1).Unlist
End Sub
Sub msxml_read_in_xml_grades()
  ' the MSXML Parser is used for copying the grades data
  ' onto the Data sheet
  ' A reference must be made to the parser
  ' using the Tools . . . References menu
  Sheets("Data").Activate
  ' set object variables needed for working with the XML
  Dim xmlsource As DOMDocument
  Dim xmlnode As IXMLDOMNode
  Dim recordcount As Integer
  ' open the XML file . . .
  Set xmlsource = New DOMDocument
  xmlsource.async = False
  xmlsource.Load ActiveWorkbook.Path & "\grades.xml"
  recordcount = 1
  ' put headers in row 1
  Set xmlnode = xmlsource.documentElement.childNodes(1)
  For readxml = 1 To xmlnode.childNodes.Length
    Cells(recordcount, 1) = xmlnode.childNodes(0).nodeName
    Cells(recordcount, 2) = xmlnode.childNodes(1).nodeName
    Cells(recordcount, 3) = xmlnode.childNodes(2).nodeName
    Cells(recordcount, 4) = xmlnode.childNodes(3).nodeName
    Cells(recordcount, 5) = xmlnode.childNodes(4).nodeName
  Next
  ' read through XML file, and insert data into
  ' successive worksheet rows
  ' the incremental recordcount variable is used to indicate
  ' the row number
  For Each xmlnode In xmlsource.documentElement.childNodes
    For readxml = 1 To xmlnode.childNodes.Length
      recordcount = recordcount + 1
      Cells(recordcount, 1) = xmlnode.childNodes(0).Text
      Cells(recordcount, 2) = xmlnode.childNodes(1).Text
      Cells(recordcount, 3) = xmlnode.childNodes(2).Text
      Cells(recordcount, 4) = xmlnode.childNodes(3).Text
      Cells(recordcount, 5) = xmlnode.childNodes(4).Text
    Next
  Next
End Sub


					  


PREVIEW

                                                                          

Not a subscriber?

Start A Free Trial


  
  • Creative Edge
  • Create BookmarkCreate Bookmark
  • Create Note or TagCreate Note or Tag
  • PrintPrint