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
- Build an Excel Add-In 1 – Basic Routine
- Build an Excel Add-In 2 – Enhanced Functionality
- Build an Excel Add-In 3 – Auxiliary Modular Functions
- Build an Excel Add-In 4 – Create the Dialog
- Build an Excel Add-In 5 – Tie the Code Together
- Build an Excel Add-In 6 – Interface for 2003
- Build an Excel Add-In 7 – Interface for 2007
- Build an Excel Add-In 8 – Last Steps
- Build an Excel Add-In 9 – Deployment