这是BurnUpApplication Module中的相关代码：
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
在CBurnUp类中调用以下代码：
Public Property Get CumulativeSizeRange() As Range
Set CumulativeSizeRange = mSizeCumulative
End Property
在CSlice类中调用以下代码：
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
这在Excel 2011中运行良好!!
这是完整的项目代码：
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
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
Option Explicit
Private mWS As Worksheet
Public Sub init(projectWs As Worksheet)
Set mWS = projectWs
End Sub
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
renderscriptTargetApi 21+