Welcome to part 3 of the S-Curve macro. Part 2 ended with code that copied all time phased data to Excel. Now we want to make sure the data starts with a zero value so the line on the graph starts at zero work. Then the macro will create the S-Curve charts in Excel. Here is the code:
'move xlr down a row at a time until all 4 columns have a zero start point
Index = 0
Set xlRzero = xlR
Do Until Index >= 4
If IsEmpty(xlRzero.Range("B1")) And xlRzero.Range("B2") > 0 Then
xlRzero.Range("B1") = 0
Index = Index + 1
End If
If IsEmpty(xlRzero.Range("C1")) And xlRzero.Range("C2") > 0 Then
xlRzero.Range("C1") = 0
Index = Index + 1
End If
If IsEmpty(xlRzero.Range("D1")) And xlRzero.Range("D2") > 0 Then
xlRzero.Range("D1") = 0
Index = Index + 1
End If
If IsEmpty(xlRzero.Range("E1")) And xlRzero.Range("E2") > 0 Then
xlRzero.Range("E1") = 0
Index = Index + 1
End If
Set xlRzero = xlRzero.Offset(1, 0)
Loop
'Create Charts
Set xlrChart = xlApp.Range("A4")
If Val(xlApp.Version) >= 12 Then 'Excel 2007
'Create Charts
xlApp.Range(xlR, xlR.End(xlDown).Range("C1")).Select
xlApp.ActiveSheet.Shapes.AddChart.Select
xlApp.ActiveChart.ChartType = xlLine
xlApp.Range(xlR.Address & ":" & xlR.End(xlDown).Address & "," & xlR.Range("D1").Address & ":" & xlR.End(xlDown).Range("E1").Address).Select
xlApp.ActiveSheet.Shapes.AddChart.Select
xlApp.ActiveChart.ChartType = xlLine
'Format charts
With xlApp.ActiveSheet.ChartObjects("Chart 1") '.Chart
.Left = xlrChart.Left
.Top = xlrChart.Top
.Height = xlrChart.Offset(RowsHigh, 0).Top - xlrChart.Top
.Width = xlrChart.Offset(0, ColumnsWide).Left - xlrChart.Left
.Chart.HasTitle = True
.Chart.ChartTitle.Text = "Cumulative Work"
xlApp.ActiveSheet.ChartObjects("Chart 1").Chart.Legend.Position = xlBottom
End With
Set xlrChart = xlrChart.Offset(RowsHigh, 0)
With xlApp.ActiveSheet.ChartObjects("Chart 2")
.Left = xlrChart.Left
.Top = xlrChart.Top
.Height = xlrChart.Offset(RowsHigh, 0).Top - xlrChart.Top
.Width = xlrChart.Offset(0, ColumnsWide).Left - xlrChart.Left
.Chart.HasTitle = True
.Chart.ChartTitle.Text = "Cumulative Cost"
xlApp.ActiveSheet.ChartObjects("Chart 2").Chart.Legend.Position = xlBottom
End With
xlApp.Range("A1:E1").EntireColumn.ColumnWidth = 12
Else 'Excel 2003 or earlier
xlApp.Charts.Add
With xlApp.ActiveChart
.ChartType = xlLine
.SetSourceData Source:=xlApp.Sheets("Sheet1").Range(xlR, _ xlR.End(xlDown).Range("C1")), PlotBy:=xlColumns
.Location Where:=xlLocationAsObject, Name:="Sheet1"
xlApp.ActiveChart.PlotArea.Interior.ColorIndex = xlNone
xlApp.ActiveChart.HasTitle = True
xlApp.ActiveChart.ChartTitle.Characters.Text = "Cumulative Work"
xlApp.ActiveChart.Legend.Position = xlBottom
With xlApp.ActiveSheet.Shapes("Chart 1")
.Left = xlrChart.Left
.Top = xlrChart.Top
.Height = xlrChart.Offset(RowsHigh, 0).Top - xlrChart.Top
.Width = xlrChart.Offset(0, ColumnsWide).Left - xlrChart.Offset(0, 1).Left
End With
End With
Set xlrChart = xlrChart.Offset(RowsHigh, 0)
xlApp.Charts.Add
With xlApp.ActiveChart
.ChartType = xlLine
.SetSourceData Source:=xlApp.Sheets("Sheet1").Range(xlR.Address & ":" & _
xlR.End(xlDown).Address & "," & xlR.Range("D1").Address & ":" & _
xlR.End(xlDown).Range("E1").Address), PlotBy:=xlColumns
.Location Where:=xlLocationAsObject, Name:="Sheet1"
xlApp.ActiveChart.PlotArea.Interior.ColorIndex = xlNone
xlApp.ActiveChart.HasTitle = True
xlApp.ActiveChart.ChartTitle.Characters.Text = "Cumulative Cost"
xlApp.ActiveChart.Legend.Position = xlBottom
With xlApp.ActiveSheet.Shapes("Chart 2")
.Left = xlrChart.Left
.Top = xlrChart.Top
.Height = xlrChart.Offset(RowsHigh, 0).Top - xlrChart.Top
.Width = xlrChart.Offset(0, ColumnsWide).Left - xlrChart.Offset(0, 1).Left
End With
End With
xlApp.Range("A1:E1").EntireColumn.ColumnWidth = 15
End If
xlApp.Range("A1").Select
'Tidy up
' xlApp.ActiveSheet.PageSetup.Orientation = xlLandscape
xlApp.Range("B1:C1").EntireColumn.NumberFormat = "#,##0\h"
xlApp.Range("D1:E1").EntireColumn.NumberFormat = _
ActiveProject.CurrencySymbol & "#,###,##0"
Set xlApp = Nothing
Application.ActivateMicrosoftApp pjMicrosoftExcel
If you run the code now, you will see the data in four columns: "Baseline Work", "Work", "Baseline Cost" and "Cost". The zero value loop moves the xlrzero pointer down the data. When the cell below the one pointed to by xlrzero is not nothing, then the beginning of the data for this column has been found. Set the last empty cell to zero. This will force the beginning of the data curves to start with a zero value, which is what you expect for an S-Curve.
Now for the code to create the charts. This is easier than you might think, but complicated by the fact that the code required is slightly different for Excel 2007 than for Excel 2003. To create this code, I recorded macros in Excel 2003 and 2007 to create the two charts in the position and size I wanted, then I edited the code to make it work in Project VBA. Editing mostly involved adding an xlApp qualifier to the start of all Excel VBA code.
The following constants were declared to make it easier to calculate the locations for the two charts:
Const ColumnsWide = 7
Const RowsHigh = 22
Finally there is some code to tidy up the code, set landscape for printing and format the data.
Each of you will likely find one part of the code easy to understand a different part harder. To help understand what is happening, click anywhere in the code in the Project VBA then press F8 to single step through the code. After a line or two, swap to Excel to see exactly what the last step or two has done and you will find the code much easier to understand.
My intentions for the next blog are to create an add-in for Project using Visual Studio 2008. The add-in will simply let you clear all estimated ? marks from durations, round durations to a whole number and change the units for durations. All of these actions are fairly regular requests in the Microsoft Project news groups.
Until then, happy coding,
Rod Gill.