Here's the relevant code in the BurnUpApplication Module:
For Each slice In slices graph.drawSlice slice Next Which calls the following code in a CBurnUp class:
Public Sub drawSlice(slice As CSlice) With self.SeriesCollection.Add(slice.CumulativeSizeRange()) .xValues = mXAxis .name = slice.name .Format.Line.ForeColor.RGB = RGB(slice.Color_Red, slice.Color_Green, slice.Color_Blue) End With sliceCounter = sliceCounter + 1 End Sub Which calls the following code in CSlice class:
Public Property Get CumulativeSizeRange() As Range Set CumulativeSizeRange = mSizeCumulative End Property This works fine in Excel 2011!!
Here's the full project code:
BurnUpApplication Module
Option Explicit Dim graph As CBurnUp Const PROJECT_WS_NAME = "Project" Const TEMPLATE_WS_NAME = "Template" Const DATA_TABLE_WS_NAME = "DataTable" Const BURNUP_WS_NAME = "BurnUp" Sub onClick_UpdateBurnUp() WaitDialog.Show vbModeless End Sub Sub UpdateBurnup() Dim projectWs As Worksheet Set projectWs = Worksheets(PROJECT_WS_NAME) UpdateDataTableSlices projectWs, Worksheets(DATA_TABLE_WS_NAME) Set graph = New CBurnUp graph.init Worksheets(BURNUP_WS_NAME).ChartObjects(1).Chart Dim slice As CSlice Dim slices As Collection Dim dateRange As Range graph.clean With projectWs graph.XAxis = Union(getVisibleDataFrom(.Columns(1)), _ getVisibleDataFrom(.Columns(2)), _ getVisibleDataFrom(.Columns(3))) Set dateRange = getVisibleDataFrom(.Columns(3)) End With Set slices = getSliceList For Each slice In slices graph.drawSlice slice Next graph.drawForecast getVisibleDataFrom(Worksheets(DATA_TABLE_WS_NAME).Columns(getProperty("CURRENT_FORECAST_COLUMN"))) graph.drawBurnedPoints getVisibleDataFrom(Worksheets(DATA_TABLE_WS_NAME).Columns(getProperty("BURNED_POINTS_COLUMN"))) drawPlannedDatesAndContingency graph, slices, getPlannedBurnUp For Each slice In slices graph.drawSliceName slice graph.drawReleaseDate slice, dateRange graph.drawMilestoneDate slice, dateRange Next Unload WaitDialog Worksheets("BurnUp").Activate End Sub Sub onClick_SetPlan() Dim currentForecast As Range Dim plannedBurnup As Range If getProperty("IS_PROJECT_STARTED") = True Then Dim dialogResult As VbMsgBoxResult dialogResult = MsgBox("You have choosen to Set a new Baseline. Contingency and expectations will be changed accoring to the current velocity. Do you want to continue?", vbYesNo, "Burnup - Rebase") If dialogResult = vbNo Then Exit Sub End If End If 'take forecasted burnup Set currentForecast = getDataFrom(Worksheets(DATA_TABLE_WS_NAME).Columns(getProperty("CURRENT_FORECAST_COLUMN"))) 'copy to Planned BurnUp Set plannedBurnup = getDataFrom(Worksheets(PROJECT_WS_NAME).Columns(getProperty("PLANNED_FORECAST_COLUMN"))) currentForecast.Copy plannedBurnup.PasteSpecial xlPasteValues ' if there is a sampled average velocity change the avg updatePlannedVelocityWithSampledOne updateSliceSize Worksheets(PROJECT_WS_NAME) 'the planned velocity End Sub Sub updatePlannedVelocityWithSampledOne() Dim plannedVelPerEng As Range Dim sampledVelPerEng As Range Set plannedVelPerEng = Worksheets(PROJECT_WS_NAME).Cells(getProperty("PLANNED_VEL_ROW"), getProperty("PLANNED_VEL_COL")) Set sampledVelPerEng = Worksheets(PROJECT_WS_NAME).Cells(getProperty("SAMPLED_VEL_ROW"), getProperty("SAMPLED_VEL_COL")) '' If Not WorksheetFunction.IsNA(sampledVelPerEng) Then plannedVelPerEng.Value = sampledVelPerEng.Value End If End Sub Sub updateSliceSize(inWs As Worksheet) Dim isStart, isEnd As Byte Dim iCursor As Byte Dim currentIteration As Byte Dim firstDataRow As Byte firstDataRow = getProperty("FIRST_DATA_ROW") isStart = getProperty("PROJECT_SLICES_START_COLUMN") + 1 isEnd = getProperty("PROJECT_SLICES_END_COLUMN") currentIteration = getProperty("CURRENT_ITERATION_INDEX") + firstDataRow iCursor = isStart Do While iCursor < isEnd inWs.Cells(2, iCursor).Formula = "=" & inWs.Cells(currentIteration, iCursor).Address(False, False) inWs.Cells(currentIteration, iCursor).Interior.Color = inWs.Cells(firstDataRow, iCursor).Interior.Color iCursor = iCursor + 1 Loop End Sub Sub drawPlannedDatesAndContingency(burnUp As CBurnUp, slices As Collection, plannedBurnup As Range) Dim s As CSlice Dim i As Byte Dim contingencySize As Double Dim currentIteration As Byte currentIteration = 0 For Each s In slices s.StartingIteration = currentIteration For i = 1 To plannedBurnup.Count If (plannedBurnup.Cells(i).Value >= s.CumulativeWithContingency) Then currentIteration = i If s.contingency > 0 Then contingencySize = getContingencySize(s, plannedBurnup, s.StartingIteration, currentIteration) burnUp.drawContingency i, s.Cumulative(i), contingencySize End If Exit For End If Next Next End Sub Function getContingencySize(slice As CSlice, plannedBurnup As Range, startIt As Byte, endIt As Byte) As Double Dim contingencySize As Double ' previous version with linear velocity 'contingencySize = contingency / averageSliceVelocity(plannedBurnup, startIt, endIt) 'contingencySize = Application.WorksheetFunction.RoundDown(contingencySize, 2) Dim i As Byte Dim burnedPoints As Double Dim remainingContingency As Double i = endIt remainingContingency = slice.contingency ' new version based on burned points Do While remainingContingency > 0 burnedPoints = plannedBurnup.Cells(i) - plannedBurnup.Cells(i - 1) If remainingContingency > burnedPoints Then remainingContingency = remainingContingency - burnedPoints contingencySize = contingencySize + 1 Else contingencySize = contingencySize + remainingContingency / burnedPoints remainingContingency = 0 End If i = i - 1 Loop getContingencySize = contingencySize End Function Function averageSliceVelocity(plannedBurnup As Range, startIt As Byte, endIt As Byte) As Double If (endIt - startIt) = 0 Then 'if the slice is completed in one iteration the avg velovity is the velocity of that iteration averageSliceVelocity = (plannedBurnup.Cells(endIt).Value - plannedBurnup.Cells(endIt - 1).Value) Else averageSliceVelocity = (plannedBurnup.Cells(endIt).Value - plannedBurnup.Cells(startIt).Value) / (endIt - startIt) End If End Function Function createSlice(sliceRange As Range) As CSlice Dim slice As CSlice Set slice = New CSlice slice.init sliceRange Set createSlice = slice End Function Function getSliceList() As Collection Dim slices As Collection Dim sStart, sEnd As Byte Set slices = New Collection sStart = getProperty("SLICES_START_COLUMN") + 1 sEnd = getProperty("SLICES_END_COLUMN") Do While sStart < sEnd With Worksheets(DATA_TABLE_WS_NAME) slices.Add createSlice(Union(.Columns(sStart), .Columns(sStart + 1), .Columns(sStart + 2))) End With sStart = sStart + 3 Loop Set getSliceList = slices End Function Function getPlannedBurnUp() As Range Set getPlannedBurnUp = getVisibleDataFrom(Worksheets(PROJECT_WS_NAME).Columns(getProperty("PLANNED_FORECAST_COLUMN"))) End Function Function getVisibleDataFrom(Column As Range) As Range Set getVisibleDataFrom = Column.Worksheet.Range(Column.Cells(getProperty("FIRST_DATA_ROW"), 1), _ Column.Cells(getProperty("LAST_DATA_ROW"), 1)) End Function Function getDataFrom(Column As Range) As Range Set getDataFrom = Column.Worksheet.Range(Column.Cells(getProperty("FIRST_DATA_ROW"), 1), _ Column.Cells(getProperty("MAX_NUMBER_OF_IT"), 1)) End Function Sub UpdateDataTableSlices(inWs As Worksheet, outWs As Worksheet) Dim osStart, osEnd, isStart, isEnd As Byte Dim iCursor, oCursor As Byte osStart = getProperty("SLICES_START_COLUMN") + 1 osEnd = getProperty("SLICES_END_COLUMN") isStart = getProperty("PROJECT_SLICES_START_COLUMN") + 1 isEnd = getProperty("PROJECT_SLICES_END_COLUMN") If Not (osStart = osEnd) Then outWs.Columns(osStart).Resize(, osEnd - osStart).Delete End If If Not (isStart = isEnd) Then outWs.Columns(osStart).Resize(, (isEnd - isStart) * 3).Insert End If iCursor = isStart oCursor = osStart Do While iCursor < isEnd inWs.Columns(iCursor).Copy outWs.Columns(oCursor).PasteSpecial ' copy cumulative column from template Worksheets(TEMPLATE_WS_NAME).Columns(5).Copy outWs.Columns(oCursor + 1).PasteSpecial ' copy contingency column from template Worksheets(TEMPLATE_WS_NAME).Columns(6).Copy outWs.Columns(oCursor + 2).PasteSpecial oCursor = oCursor + 3 iCursor = iCursor + 1 Loop 'This line is added because when exit from Excel the application ask if you want to save the data in clipboard Worksheets(TEMPLATE_WS_NAME).Cells(1, 1).Copy End Sub CBurnUp Class
Option Explicit Const CONTINGENCY_RECT_HEIGHT = 6 Const CONTINGENCY_SCALE = 6 Private unitPerIteration As Double Private unitPerValueY As Double Private self As Chart Private originX, originY As Double Private sliceCounter As Byte Private mXAxis As Range Private NUMBER_OF_IT_TO_DISPLAY As Byte Public Sub init(chartInstance As Chart) Set self = chartInstance NUMBER_OF_IT_TO_DISPLAY = getProperty("NUMBER_OF_IT_TO_DISPLAY") End Sub Property Let XAxis(xValues As Range) Set mXAxis = xValues End Property Public Sub drawSlice(slice As CSlice) With self.SeriesCollection.Add(slice.CumulativeSizeRange()) .xValues = mXAxis .name = slice.name .Format.Line.ForeColor.RGB = RGB(slice.Color_Red, slice.Color_Green, slice.Color_Blue) End With sliceCounter = sliceCounter + 1 End Sub Public Sub drawForecast(forecastRange As Range) Dim newRange As Range Set newRange = forecastRange With self.SeriesCollection.Add(forecastRange) .xValues = mXAxis .Format.Line.DashStyle = msoLineDash .name = "Forecast" .Format.Line.ForeColor.RGB = RGB(105, 140, 140) End With End Sub Public Sub drawBurnedPoints(burnedPoints As Range) With self.SeriesCollection.Add(burnedPoints) .xValues = mXAxis .name = "BurnedPoints" .Format.Line.ForeColor.RGB = RGB(233, 91, 80) End With End Sub Public Sub clean() Dim s As Series Dim sh As Shape For Each s In self.SeriesCollection s.Delete Next s For Each sh In self.Shapes sh.Delete Next sh sliceCounter = 0 End Sub Public Sub drawContingency(forecastedIteration As Byte, scope As Double, contingSize As Double) If scope = 0 Then Exit Sub End If Dim rectPosX, rectPosY As Double Dim rectW, rectH As Double If (contingSize > 0) Then With self.PlotArea originY = .InsideTop originX = .InsideLeft unitPerIteration = .InsideWidth / NUMBER_OF_IT_TO_DISPLAY unitPerValueY = .InsideHeight / self.Axes(xlValue).MaximumScale rectW = getUnitsForItPerc(contingSize) rectH = CONTINGENCY_RECT_HEIGHT rectPosX = .InsideLeft + (forecastedIteration * unitPerIteration) - rectW - (unitPerIteration / 2) rectPosY = .InsideTop + .InsideHeight - (scope * unitPerValueY) - (rectH / 2) ' Create Rect With self.Shapes.AddShape(msoShapeRectangle, rectPosX, rectPosY, rectW, rectH) With .Fill .Visible = True .ForeColor.RGB = vbYellow .BackColor.RGB = vbYellow End With With .Line .Visible = True .ForeColor.RGB = RGB(0, 0, 0) .BackColor.RGB = RGB(0, 0, 0) End With End With End With End If drawLine forecastedIteration End Sub Public Sub drawSliceName(slice As CSlice) Dim txtPosX, txtPosY As Double Dim rectW, rectH As Double With self.PlotArea originY = .InsideTop originX = .InsideLeft unitPerIteration = .InsideWidth / NUMBER_OF_IT_TO_DISPLAY unitPerValueY = .InsideHeight / self.Axes(xlValue).MaximumScale txtPosX = .width + .InsideLeft txtPosY = .InsideTop + .InsideHeight - (slice.Cumulative(NUMBER_OF_IT_TO_DISPLAY) * unitPerValueY) ' Create Rect With self.Shapes.AddTextbox(msoTextOrientationHorizontal, txtPosX, txtPosY, self.ChartArea.width - .width - .Left, 60) .TextFrame.AutoSize = False .TextFrame.VerticalAlignment = xlVAlignCenter .TextFrame.Characters.Font.Size = 14 .TextFrame.Characters.Text = slice.name .TextFrame.Characters.Font.Color = RGB(slice.Color_Red, slice.Color_Green, slice.Color_Blue) .Left = .Left + .width .Top = .Top - (.height / 2) End With End With End Sub Private Sub drawLine(forecastedIteration As Byte) Dim linePosX, linePosY As Double With self.PlotArea unitPerIteration = .InsideWidth / NUMBER_OF_IT_TO_DISPLAY unitPerValueY = .InsideHeight / self.Axes(xlValue).MaximumScale linePosX = .InsideLeft + (forecastedIteration * unitPerIteration) - (unitPerIteration / 2) linePosY = .InsideTop ' Create line With self.Shapes.AddLine(linePosX, linePosY, linePosX, .InsideHeight + .InsideTop) .Line.DashStyle = msoLineDash .Line.Weight = xlThin .Line.ForeColor.RGB = RGB(150, 150, 150) End With End With End Sub Private Function getUnitsForItPerc(iterationPercentage As Double) getUnitsForItPerc = unitPerIteration * iterationPercentage End Function Public Sub drawReleaseDate(slice As CSlice, dateRange As Range) Dim chart_x, chart_y As Double Dim release_date As Date Dim width, height As Double Dim forecasted_iteration As Double Dim previous_iteration_end_date, next_iteration_end_date As Date If slice.HasAReleseDate = True Then release_date = slice.ReleaseDate If dateRange(1, 1) > release_date Then Exit Sub End If If dateRange(NUMBER_OF_IT_TO_DISPLAY, 1) < release_date Then Exit Sub End If Else Exit Sub End If With self.PlotArea originY = .InsideTop originX = .InsideLeft unitPerIteration = .InsideWidth / NUMBER_OF_IT_TO_DISPLAY unitPerValueY = .InsideHeight / self.Axes(xlValue).MaximumScale forecasted_iteration = WorksheetFunction.Match(Int(CDbl(release_date)), dateRange, 1) previous_iteration_end_date = dateRange(forecasted_iteration, 1).Value next_iteration_end_date = dateRange(forecasted_iteration + 1, 1).Value forecasted_iteration = forecasted_iteration + (release_date - previous_iteration_end_date) _ / (next_iteration_end_date - previous_iteration_end_date) width = 16 height = 16 chart_x = .InsideLeft + (forecasted_iteration * unitPerIteration) - (unitPerIteration / 2) - (width / 2) chart_y = .InsideTop + .InsideHeight - ((slice.Cumulative(forecasted_iteration)) * unitPerValueY) ' Create Rect With self.Shapes.AddShape(msoShapeIsoscelesTriangle, chart_x, chart_y, width, height) With .Fill .Visible = True .ForeColor.RGB = RGB(slice.Color_Red, slice.Color_Green, slice.Color_Blue) .BackColor.RGB = RGB(slice.Color_Red, slice.Color_Green, slice.Color_Blue) End With With .Line .Visible = True .ForeColor.RGB = RGB(slice.Color_Red, slice.Color_Green, slice.Color_Blue) .BackColor.RGB = RGB(slice.Color_Red, slice.Color_Green, slice.Color_Blue) End With End With End With End Sub Public Sub drawMilestoneDate(slice As CSlice, dateRange As Range) Dim chart_x, chart_y As Double Dim release_date As Date Dim width, height As Double Dim forecasted_iteration As Double Dim previous_iteration_end_date, next_iteration_end_date As Date If slice.HasAMilestoneDate = True Then release_date = slice.MilestoneDate If dateRange(1, 1) > release_date Then Exit Sub End If If dateRange(NUMBER_OF_IT_TO_DISPLAY, 1) < release_date Then Exit Sub End If Else Exit Sub End If With self.PlotArea originY = .InsideTop originX = .InsideLeft unitPerIteration = .InsideWidth / NUMBER_OF_IT_TO_DISPLAY unitPerValueY = .InsideHeight / self.Axes(xlValue).MaximumScale forecasted_iteration = WorksheetFunction.Match(Int(CDbl(release_date)), dateRange, 1) previous_iteration_end_date = dateRange(forecasted_iteration, 1).Value next_iteration_end_date = dateRange(forecasted_iteration + 1, 1).Value forecasted_iteration = forecasted_iteration + (release_date - previous_iteration_end_date) _ / (next_iteration_end_date - previous_iteration_end_date) width = 16 height = 16 chart_x = .InsideLeft + (forecasted_iteration * unitPerIteration) - (unitPerIteration / 2) - (width / 2) chart_y = .InsideTop + .InsideHeight - ((slice.Cumulative(forecasted_iteration)) * unitPerValueY) - (height / 2) ' Create Rect With self.Shapes.AddShape(msoShapeDiamond, chart_x, chart_y, width, height) With .Fill .Visible = True .ForeColor.RGB = RGB(0, 0, 0) .BackColor.RGB = RGB(0, 0, 0) End With With .Line .Visible = True .ForeColor.RGB = RGB(0, 0, 0) .BackColor.RGB = RGB(0, 0, 0) End With End With End With End Sub CSlice Class
Option Explicit Const TPL_THIRD_COLUMN = 3 Const TPL_SECOND_COLUMN = 2 Const TPL_FIRST_COLUMN = 1 Private mSizeCumulative As Range Private mCumulativeSizeWithContingency As Double Private mSizeWithPreviousContingency As Double Private mSize As Range Private mPlannedSize As Range Private mName As String Private mContingency As Double Private mColor As Range Private mReleaseDate As Date Private mMilestoneDate As Date Private mHasMilestoneDate As Boolean Private mHasReleaseDate As Boolean Private mStartingIteration As Byte Public Sub init(sliceRange As Range) 'Header mName = sliceRange.Cells(getProperty("SLICE_NAME_ROW"), TPL_FIRST_COLUMN) mContingency = sliceRange.Cells(getProperty("CONTINGENCY_ROW"), TPL_THIRD_COLUMN) mCumulativeSizeWithContingency = sliceRange.Cells(getProperty("SIZE_PLUS_CONT_ROW"), TPL_THIRD_COLUMN) mSizeWithPreviousContingency = sliceRange.Cells(getProperty("PLANNED_SIZE_ROW"), TPL_THIRD_COLUMN) 'Values Set mPlannedSize = sliceRange.Cells(getProperty("PLANNED_SIZE_ROW"), TPL_FIRST_COLUMN) Set mSize = getVisibleDataFrom(sliceRange.Columns(TPL_FIRST_COLUMN)) Set mSizeCumulative = getVisibleDataFrom(sliceRange.Columns(TPL_SECOND_COLUMN)) 'Dates mHasReleaseDate = Not (sliceRange.Cells(getProperty("RELEASE_DATE_ROW"), TPL_FIRST_COLUMN) = "") mReleaseDate = sliceRange.Cells(getProperty("RELEASE_DATE_ROW"), TPL_FIRST_COLUMN) mHasMilestoneDate = Not (sliceRange.Cells(getProperty("MILESTONE_DATE_ROW"), TPL_FIRST_COLUMN) = "") mMilestoneDate = sliceRange.Cells(getProperty("MILESTONE_DATE_ROW"), TPL_FIRST_COLUMN) 'Color Set mColor = sliceRange.Cells(getProperty("SLICE_COLOR_ROW"), TPL_FIRST_COLUMN) End Sub Property Get CumulativeWithContingency() As Double CumulativeWithContingency = mCumulativeSizeWithContingency End Property 'Current one without contingency plus previous one with cont Property Get CumulativePreviousContingency() As Double CumulativePreviousContingency = mSizeWithPreviousContingency End Property Property Get Cumulative(ByVal itIndex As Double) As Double Cumulative = mSizeCumulative(itIndex, 1) End Property Public Property Get CumulativeSizeRange() As Range Set CumulativeSizeRange = mSizeCumulative End Property Public Property Get name() As String name = mName End Property Public Property Let PlannedSize(Size As Double) mPlannedSize.Value = Size End Property Public Property Get Color_Red() As Integer Color_Red = Int(mColor.Interior.Color Mod 256) End Property Public Property Get Color_Blue() As Integer Color_Blue = Int(mColor.Interior.Color / 256 / 256) Mod 256 End Property Public Property Get Color_Green() As Integer Color_Green = Int(mColor.Interior.Color / 256) Mod 256 End Property Public Property Get contingency() As Double contingency = mContingency End Property Public Property Get ReleaseDate() As Date ReleaseDate = mReleaseDate End Property Public Property Get HasAReleseDate() As Boolean HasAReleseDate = mHasReleaseDate End Property Public Property Get MilestoneDate() As Date MilestoneDate = mMilestoneDate End Property Public Property Get HasAMilestoneDate() As Boolean HasAMilestoneDate = mMilestoneDate End Property Public Property Get StartingIteration() As Byte StartingIteration = mStartingIteration End Property Public Property Let StartingIteration(it As Byte) mStartingIteration = it End Property Private Sub Class_Initialize() End Sub Project Class
Option Explicit Private mWS As Worksheet Public Sub init(projectWs As Worksheet) Set mWS = projectWs End Sub Configuration Module
Option Explicit Const CONF_WORKSHEET_NAME = "Configuration" Const KEY_COLUMN = 1 Const VAL_COLUMN = 2 Public Function getProperty(name As String) Dim confWS As Worksheet Set confWS = ActiveWorkbook.Worksheets(CONF_WORKSHEET_NAME) getProperty = WorksheetFunction.Index(confWS.Columns(VAL_COLUMN), WorksheetFunction.Match(name, confWS.Columns(KEY_COLUMN), 0)) End Function 
0 comments:
Post a Comment