Peltier Tech Blog

Excel Chart Add-Ins | Training | Custom Solutions | Charts and Tutorials | PTS Blog

 

Main menu:

 
Peltier Tech
Chart Add-Ins

Peltier Tech Waterfall Chart Utility
Peltier Tech Cluster-Stack Chart Utility
Peltier Tech Box and Whisker Chart Utility
Peltier Tech Marimekko Chart Utility
Peltier Tech Dot Plot Utility
Peltier Tech Cascade Chart Utility

 
Excel Dashboards

Subscribe

Site search

Subscribe

Site search


Recent Posts

Recently Commented

Popular Posts

Archive


 

Categories


 

Privacy Policy

Creative Commons License
Licensed under a Creative Commons Attribution-Noncommercial-Share Alike 3.0 Unported License.

Build an Excel Add-In 2 – Enhanced Functionality

by Jon Peltier
Wednesday, January 6th, 2010
Peltier Technical Services, Inc., Copyright © 2010.
Licensed under a Creative Commons Attribution-Noncommercial-Share Alike 3.0 Unported License.

In Build an Excel Add-In 1 – Basic Routine I coded a procedure in VBA to create a regular chart from an arbitrary rectangular range, including from a pivot table. In this post I will begin the process of turning this routine into an Excel add-in.

The VBA procedure in Build an Excel Add-In 1 – Basic Routine is a subroutine which creates a chart using a number of built-in (hard-coded) options. In this post I will show how to make this subroutine into a modular function, which allows a calling procedure to pass these options into the procedure. This adds the flexibility that allows the function to create a variety of charts based on different options. In a future installment of this series I will build a dialog (a VBA UserForm) which allows a user to select these options.

Modular Function

The first step in the transformation is to turn the subroutine in the previous step:

Sub PT_Plot() 

into a function with parameters for the various options:

Function PT_Plotter_Chart(DataRange As Range, DataOrientation As XlRowCol, _
    HeaderRows As Long, HeaderColumns As Long, ChartType As XlChartType, _
    Optional PositionRange As Range) As Chart

The parameters passed into this function are:

DataRange: a Range object containing the chart's source data
DataOrientation: whether series are specified by xlColumns or xlRows
HeaderRows: number of header rows in the data range (series names or category values)
HeaderColumns: number of header columns in the data range (series names or category values)
ChartType: type of chart to create (XY, Line, Area, Column, Bar)
PositionRange (optional): range of cells that chart object will cover 

The result of the function is a reference to the chart created in the function.

The calling procedure has defined the values of these parameters, and our function has to adjust its execution to account for these values.

Chart Source Data Range

In the original sub, if the selection is not a range, execution exits the procedure. Otherwise the selected range becomes the source data range:

  If TypeName(Selection) <> "Range" Then
    MsgBox "Select a range and try again.", vbOKOnly, "No Range Selected"
    GoTo ExitProcedure
  End If
  Set rData = Selection

In the new function, DataRange As Range is passed into the function.

Header Rows and Columns, and Data Orientation

The original sub assumes that there is one header row and one header column. The range containing the series values is offset one row down and one column right of the source data range, and reduced in size by one row and one column. In addition, it assumes that series are defined by columns, so the series names are defined as the top row, the category values as the left column, and the number of series as the number of columns in the series values range.

  With rData
    Set rValues = .Offset(1, 1).Resize(.Rows.Count - 1, .Columns.Count - 1)
    nSrs = .Columns.Count - 1
    Set rNames = .Offset(, 1).Resize(1, nSrs)
    Set rCats = .Offset(1).Resize(.Rows.Count - 1, 1)
  End With

The new function adjusts the position and size of the range containing the series values by the number of header rows and columns it is passed. The data orientation helps to define the number of series, the series names, and the category values.

  With DataRange
    Set rValues = .Offset(HeaderRows, HeaderColumns) _
        .Resize(.Rows.Count - HeaderRows, .Columns.Count - HeaderColumns)
    Select Case DataOrientation
      Case xlColumns
        nSrs = .Columns.Count - HeaderColumns
        Set rNames = .Offset(, HeaderColumns).Resize(HeaderRows, nSrs)
        Set rCats = .Offset(HeaderRows) _
            .Resize(.Rows.Count - HeaderRows, HeaderColumns)
      Case xlRows
        nSrs = .Rows.Count - HeaderRows
        Set rNames = .Offset(HeaderRows).Resize(nSrs, HeaderColumns)
        Set rCats = .Offset(, HeaderColumns) _
            .Resize(HeaderRows, .Columns.Count - HeaderColumns)
    End Select
  End With 

Series are added to the chart as columns or as rows, based on the data orientation:

  For iSrs = 1 To nSrs
    Set Srs = cht.SeriesCollection.NewSeries
    With Srs
      Select Case DataOrientation
        Case xlColumns
          .Values = rValues.Columns(iSrs)
          .XValues = rCats
          .Name = "=" & rNames.Columns(iSrs).Address(ReferenceStyle:=xlR1C1, External:=True)
        Case xlRows
          .Values = rValues.Rows(iSrs)
          .XValues = rCats
          .Name = "=" & rNames.Rows(iSrs).Address(ReferenceStyle:=xlR1C1, External:=True)
      End Select
    End With
  Next 

Chart Type

The original sub does not specify a chart type, so it creates a chart of the default type. If the user has not specified their own default, then the Excel default chart type, 2D clustered column, is used.

The new function applies the specified chart type to the finished chart:

  cht.ChartType = ChartType 

Chart Position

The original sub mimics the Excel 2003 default chart object position, which is half the size of the active window, centered within the active window.

  Set rScroll = ActiveSheet.Cells(ActiveWindow.ScrollRow, ActiveWindow.ScrollColumn)
  With ActiveWindow
    dWidth = .UsableWidth / 2
    dHeight = .UsableHeight / 2
    dLeft = rScroll.Left + dWidth / 2
    dTop = rScroll.Top + dHeight / 2
  End With

If it is passed a range defining the chart position, the new function covers this range with the chart object.

    With PositionRange
      dLeft = .Left
      dTop = .Top
      dWidth = .Width
      dHeight = .Height
    End With

Otherwise, the function mimics the Excel 2003 default chart object position, using the largest pane instead of the entire active window. If the chart will be smaller than a minimum defined size, this defined minimum will be used rather than half the size of the largest pane.

    With ActiveWindow
      dWidth = .UsableWidth / 2
      dHeight = .UsableHeight / 2
      If .SplitColumn > 0 Then
        If ActiveSheet.Range("A1").Resize(, .SplitColumn).Width > dWidth Then
          dWidth = ActiveSheet.Range("A1").Resize(, .SplitColumn).Width / 2
          If dWidth < 200 Then dWidth = 200
          dLeft = ActiveSheet.Columns(.Panes(1).ScrollColumn).Left + dWidth / 2
        Else
          dWidth = dWidth - ActiveSheet.Range("A1").Resize(, .SplitColumn).Width / 2
          If dWidth < 200 Then dWidth = 200
          dLeft = ActiveSheet.Columns(.Panes(.Panes.Count).ScrollColumn).Left + dWidth / 2
        End If
      Else
        If dWidth < 200 Then dWidth = 200
        dLeft = ActiveSheet.Columns(.Panes(1).ScrollColumn).Left + dWidth / 2
      End If
      If dLeft < 40 Then dLeft = 40
      If .SplitRow > 0 Then
        If ActiveSheet.Range("A1").Resize(.SplitRow).Height > dHeight Then
          dHeight = ActiveSheet.Range("A1").Resize(.SplitRow).Height / 2
          If dHeight < 125 Then dHeight = 125
          dTop = ActiveSheet.Rows(.Panes(1).ScrollRow).Top + dHeight / 2
        Else
          dHeight = dHeight - ActiveSheet.Range("A1").Resize(.SplitRow).Height / 2
          If dHeight < 125 Then dHeight = 125
          dTop = ActiveSheet.Rows(.Panes(.Panes.Count).ScrollRow).Top + dHeight / 2
        End If
      Else
        If dHeight < 125 Then dHeight = 125
        dTop = ActiveSheet.Rows(.Panes(.Panes.Count).ScrollRow).Top + dHeight / 2
      End If
    If dTop < 25 Then dTop = 25
    End With

This set of calculations based on the splitting of the window into multiple panes is too complicated for this post, but it may be covered in a future post.

Returned Value

The function returns the chart that is created in the function:

  Set PT_Plotter_Chart = cht

Entire Code of New Function

The following is the listing of the updated procedure:

Function PT_Plotter_Chart(DataRange As Range, DataOrientation As XlRowCol, _
    HeaderRows As Long, HeaderColumns As Long, ChartType As XlChartType, _
    Optional PositionRange As Range) As Chart

  ' CREATE AND POPULATE A CHART
  ' ' Start with defined data range
  ' ' Put chart in specified (or default) position
  ' ' Use specified chart type
  ' ' Plot by row or column as specified
  ' ' Use specified rows/columns for category values
  ' ' Use specified columns/rows for series names
  ' ' Use position range (if specified) for position of chart object
  ' ' Otherwise center chart object in largest pane of active window

  Dim ChtOb As ChartObject
  Dim cht As Chart
  Dim wsPosition As Worksheet
  Dim dLeft As Double, dTop As Double, dWidth As Double, dHeight As Double
  Dim rActive As Range
  Dim rScroll As Range
  Dim rCats As Range
  Dim rNames As Range
  Dim rValues As Range
  Dim iSrs As Long, nSrs As Long
  Dim Srs As Series
  Dim bScreenUpdating As Boolean

  bScreenUpdating = Application.ScreenUpdating
  Application.ScreenUpdating = False

  If TypeName(Selection) = "Range" Then
    Set rActive = ActiveCell
    Set rScroll = ActiveSheet.Cells(ActiveWindow.ScrollRow, ActiveWindow.ScrollColumn)
  End If
  If PositionRange Is Nothing Then
    ' Position unspecified
    ' Define using 2003 configuration
    ' Put into largest pane (whole window if unsplit)
    ' Half the pane's width and height, centered in pane
    With ActiveWindow
      dWidth = .UsableWidth / 2
      dHeight = .UsableHeight / 2

      If .SplitColumn > 0 Then
        If ActiveSheet.Range("A1").Resize(, .SplitColumn).Width > dWidth Then
          dWidth = ActiveSheet.Range("A1").Resize(, .SplitColumn).Width / 2
          If dWidth < 200 Then dWidth = 200
          dLeft = ActiveSheet.Columns(.Panes(1).ScrollColumn).Left + dWidth / 2
        Else
          dWidth = dWidth - ActiveSheet.Range("A1").Resize(, .SplitColumn).Width / 2
          If dWidth < 200 Then dWidth = 200
          dLeft = ActiveSheet.Columns(.Panes(.Panes.Count).ScrollColumn).Left + dWidth / 2
        End If
      Else
        If dWidth < 200 Then dWidth = 200
        dLeft = ActiveSheet.Columns(.Panes(1).ScrollColumn).Left + dWidth / 2
      End If
      If dLeft < 40 Then dLeft = 40

      If .SplitRow > 0 Then
        If ActiveSheet.Range("A1").Resize(.SplitRow).Height > dHeight Then
          dHeight = ActiveSheet.Range("A1").Resize(.SplitRow).Height / 2
          If dHeight < 125 Then dHeight = 125
          dTop = ActiveSheet.Rows(.Panes(1).ScrollRow).Top + dHeight / 2
        Else
          dHeight = dHeight - ActiveSheet.Range("A1").Resize(.SplitRow).Height / 2
          If dHeight < 125 Then dHeight = 125
          dTop = ActiveSheet.Rows(.Panes(.Panes.Count).ScrollRow).Top + dHeight / 2
        End If
      Else
        If dHeight < 125 Then dHeight = 125
        dTop = ActiveSheet.Rows(.Panes(.Panes.Count).ScrollRow).Top + dHeight / 2
      End If
      If dTop < 25 Then dTop = 25

    End With
    Set wsPosition = ActiveSheet
  Else
    ' Position specified
    With PositionRange
      dLeft = .Left
      dTop = .Top
      dWidth = .Width
      dHeight = .Height
      Set wsPosition = .Parent
    End With
  End If

  With DataRange
    Set rValues = .Offset(HeaderRows, HeaderColumns) _
        .Resize(.Rows.Count - HeaderRows, .Columns.Count - HeaderColumns)
    Select Case DataOrientation
      Case xlColumns
        nSrs = .Columns.Count - HeaderColumns
        Set rNames = .Offset(, HeaderColumns).Resize(HeaderRows, nSrs)
        Set rCats = .Offset(HeaderRows) _
            .Resize(.Rows.Count - HeaderRows, HeaderColumns)
      Case xlRows
        nSrs = .Rows.Count - HeaderRows
        Set rNames = .Offset(HeaderRows).Resize(nSrs, HeaderColumns)
        Set rCats = .Offset(, HeaderColumns) _
            .Resize(HeaderRows, .Columns.Count - HeaderColumns)
    End Select
  End With

  ' NEED ACTIVE CELL NOT IN PIVOT TABLE WHEN CREATING CHART
  If Not rActive Is Nothing Then
    ActiveSheet.Columns(1).Cells(ActiveSheet.Rows.Count).Select
  End If

  Set cht = wsPosition.ChartObjects.Add(dLeft, dTop, dWidth, dHeight).Chart
  ' probably blank, but remove all series just in case
  For iSrs = cht.SeriesCollection.Count To 1 Step -1
    cht.SeriesCollection.Count(iSrs).Delete
  Next

  ' add series from data range
  For iSrs = 1 To nSrs
    Set Srs = cht.SeriesCollection.NewSeries
    With Srs
      Select Case DataOrientation
        Case xlColumns
          .Values = rValues.Columns(iSrs)
          .XValues = rCats
          .Name = "=" & rNames.Columns(iSrs).Address(ReferenceStyle:=xlR1C1, External:=True)
        Case xlRows
          .Values = rValues.Rows(iSrs)
          .XValues = rCats
          .Name = "=" & rNames.Rows(iSrs).Address(ReferenceStyle:=xlR1C1, External:=True)
      End Select
    End With
  Next
  cht.ChartType = ChartType

  Set PT_Plotter_Chart = cht

  ' restore original window configuration
  ActiveWindow.ScrollRow = rScroll.Row
  ActiveWindow.ScrollColumn = rScroll.Column
  If Not rActive Is Nothing Then
    DataRange.Select
    rActive.Activate
  End If

  Application.ScreenUpdating = bScreenUpdating

End Function

Contents: How to Build an Excel Add-In

.Name = “=” & rNames.Columns(iSrs).Address(ReferenceStyle:=xlR1C1, External:=True)

Related Posts:

Bookmark and share this entry:
  • Twitter
  • Digg
  • Facebook
  • LinkedIn
  • del.icio.us
  • Technorati
  • StumbleUpon
  • Google Bookmarks
  • Reddit
  • MySpace
  • Slashdot
  • Yahoo! Buzz
  • Tumblr

Learn how to create Excel dashboards.

Comments


Comment from Jan Karel Pieterse
Time: Wednesday, January 6, 2010, 5:16 am

In my experience, building the basic routine that does the actual work takes no more than 5 % of the total project time needed to create an add-in that behaves itself.
The remainder is:
- User interface design
- UI programming
- Catching and adapting to all situations a user’s file might be in
- International issues
- Excel versions
- Add-in setup
- Error handling


Comment from jasa
Time: Wednesday, January 27, 2010, 9:42 am

dear Jon,

all the code in this and related posts seem to be in one line, so it can not be copy/pasted; I’ve tried with 3 different browsers at home and at work ;(

Jasa


Comment from Jon Peltier
Time: Wednesday, January 27, 2010, 2:12 pm

Jasa -

Thanks for the notice. I think I’ve fixed the code layout problems.

If there are any more problems with code layout in other posts, I hope my readers will leave a simple message like this one.


Comment from Erik
Time: Thursday, February 18, 2010, 12:56 pm

Jon – Still pasting as a single line..

And thanks for your work, it is appreciated.


Comment from Erik
Time: Thursday, February 18, 2010, 1:04 pm

Hey Jon,

Found it, edit style.css and change the following:

.vbasmall
{ color: #000000;
background: #FFFFFF;
margin: 0px 0px 0px 0px;
padding: 0px 0px 0px 0px;
font-size: 100%
white-space: pre;
}

I added white-space:pre; and it allowed copy/paste on multiple lines.

HTH,
Erik

Write a comment

I welcome comments from my readers. If you have an opinion on this post, if you have a question or if there is anything to add, I want to hear from you. Whether you agree or disagree, please join the discussion.

If you want to include an image in your comment, post it on your own site or on one of the many free image sharing sites, and include a link in your comment. I'll download your image and insert the necessary html to display the image inline.

Read the PTS Blog Comment Policy.





Subscribe without commenting

Peltier Tech Waterfall Chart Utility Peltier Tech Cluster-Stack Chart Utility Peltier Tech Box and Whisker Chart Utility Peltier Tech Marimekko Chart Utility Peltier Tech Dot Plot Utility Peltier Tech Cascade Chart Utility

Create Excel dashboards quickly with Plug-N-Play reports.