Jim,
Complementing my last reply, I’ve just discovered how to solve the problem.
The main issue is TimeScaleData method from Task and Resource objects. So,
I’ve just included a brief routine considering a simple 8 hours/day for each
task and resource, and that’s it, it works! Now I can use SPI and CPI index.
Bellow is the code example for the ones who are interested in. With this
code, projects that have already started without resource cost and time
allocation to each task, can have the baseline costs and work values updated
without the problem of the MSP’s “Save Baseline†operation that simply throws
Work values over the original baseline, changing all original baseline data
(work, costs, start date and finish date).
IMPORTANT:
- The following code is due for support proposals only.
- It’s just recommended for the ones who have a comprehensive knowledge in
VB programming. So, take a close look in the code in order to understand what
it’s made for before running it on a test project.
- I’m not responsible for any problem on projects caused by unexpected
reasons. Run the code on a test project, then analyze all baseline fields
carefully before using it on a real project.
Public Sub UpdateBaselineCosts()
‘This routine updates the Baseline Work and Cost values of all tasks,
without changing
‘the original baseline values (start date, finish date) in order to make
Earned Value
‘fields (SPI, CPI, BCWS, BCWP, ACWP, etc) working properly
‘and based on the resource allocations for each task updated after the
baseline has ‘already been saved.
Dim Temp As Long, A As Assignment
Dim TaskName As String, Assigned As String, Results As String
Dim Tarefa As Task, TBDur As Double, AC_TBWork As Double, AC_TBCost As
Double, AC_TBDur As Double
Dim AC_PBWork As Double, AC_PBCost As Double, AC_PBDur As Double
Dim RBWork As Double, RBCost As Double
Dim objResource As Resource, Rateio As Double, CustoUso As Double
Dim NumRec As Integer, i As Integer
Dim VT_RName() As String
Dim VT_RWork() As Double
Dim VT_RCost() As Double
Dim tsv As TimeScaleValue
Dim tsvsWork As TimeScaleValues
Dim tsvsBaselineWork As TimeScaleValues
Dim tsvsBaselineCost As TimeScaleValues
Dim idx As Long
On Error GoTo ErrorHandler
NumRec = ActiveProject.Resources.Count
ReDim VT_RName(NumRec)
ReDim VT_RWork(NumRec)
ReDim VT_RCost(NumRec)
i = 1
For Each objResource In ActiveProject.Resources
Rateio = Val(objResource.StandardRate)
CustoUso = Val(objResource.CostPerUse)
VT_RName(i) = objResource.Name
VT_RWork(i) = 0
VT_RCost(i) = 0
i = i + 1
Next objResource
AC_PBCost = 0
AC_PBDur = 0
AC_PBWork = 0
For Temp = 1 To ActiveProject.Tasks.Count
TBDur =
Application.DateDifference(ActiveProject.Tasks(Temp).BaselineStart, _
ActiveProject.Tasks(Temp).BaselineFinish) / 60
AC_TBCost = 0
AC_TBDur = 0
AC_TBWork = 0
For Each A In ActiveProject.Tasks(Temp).Assignments
RBWork = TBDur * A.Units * 60
RBCost = (TBDur * Rateio) + CustoUso
A.BaselineWork = RBWork
A.BaselineCost = RBCost
A.Duration1 = TBDur * Rateio
A.BaselineStart = ActiveProject.Tasks(Temp).BaselineStart
A.BaselineFinish = ActiveProject.Tasks(Temp).BaselineFinish
AC_TBDur = AC_TBDur + TBDur
AC_TBCost = AC_TBCost + RBCost
AC_TBWork = AC_TBWork + RBWork
AC_PBDur = AC_PBDur + TBDur
AC_PBCost = AC_PBCost + RBCost
AC_PBWork = AC_PBWork + RBWork
'Buscando o recurso alocado na tarefa no vetor de recursos
For i = 1 To NumRec
If (Trim(VT_RName(i)) = Trim(A.ResourceName)) Then
Exit For
End If
Next i
VT_RWork(i) = VT_RWork(i) + RBWork
VT_RCost(i) = VT_RCost(i) + RBCost
If (Not ActiveProject.Tasks(Temp).Milestone) Then
'Atualizando Task(Temp) no TimeScaledData
With A
Set tsvsBaselineWork = .TimeScaleData( _
StartDate:=.BaselineStart, _
EndDate:=.BaselineFinish, _
Type:=pjAssignmentTimescaledBaselineWork, _
TimeScaleUnit:=pjTimescaleDays, Count:=1)
End With
With A
Set tsvsBaselineCost = .TimeScaleData( _
StartDate:=.BaselineStart, _
EndDate:=.BaselineFinish, _
Type:=pjAssignmentTimescaledBaselineCost, _
TimeScaleUnit:=pjTimescaleDays, Count:=1)
End With
'Atualizando Baseline Work TimeScaledData
For Each tsv In tsvsBaselineWork
idx = tsv.Index
If (Weekday(tsvsBaselineWork.Item(idx).StartDate) <> 1 And _
Weekday(tsvsBaselineWork.Item(idx).StartDate) <> 7) Then
tsv.Value = RBWork / (TBDur * Rateio) * 8
End If
Next tsv
'Atualizando Baseline Costs TimeScaledData
For Each tsv In tsvsBaselineCost
idx = tsv.Index
'tsv.Value = 60 * tsv.Index
If (Weekday(tsvsBaselineWork.Item(idx).StartDate) <> 1 And _
Weekday(tsvsBaselineWork.Item(idx).StartDate) <> 7) Then
tsv.Value = RBCost / ((TBDur * Rateio) / 8)
End If
Next tsv
End If
Next A
ActiveProject.Tasks(Temp).BaselineDuration = AC_TBDur * 60
ActiveProject.Tasks(Temp).BaselineCost = AC_TBCost
ActiveProject.Tasks(Temp).BaselineWork = AC_TBWork
If (Not ActiveProject.Tasks(Temp).Milestone) Then
'Atualizando Task(Temp) no TimeScaledData
With ActiveProject.Tasks(Temp)
Set tsvsBaselineWork = .TimeScaleData( _
StartDate:=.BaselineStart, _
EndDate:=.BaselineFinish, _
Type:=pjTaskTimescaledBaselineWork, _
TimeScaleUnit:=pjTimescaleDays, Count:=1)
End With
With ActiveProject.Tasks(Temp)
Set tsvsBaselineCost = .TimeScaleData( _
StartDate:=.BaselineStart, _
EndDate:=.BaselineFinish, _
Type:=pjTaskTimescaledBaselineCost, _
TimeScaleUnit:=pjTimescaleDays, Count:=1)
End With
'Atualizando Baseline Work TimeScaledData
For Each tsv In tsvsBaselineWork
idx = tsv.Index
If (Weekday(tsvsBaselineWork.Item(idx).StartDate) <> 1 And _
Weekday(tsvsBaselineWork.Item(idx).StartDate) <> 7) Then
tsv.Value = AC_TBWork / AC_TBDur * 8
End If
Next tsv
'Atualizando Baseline Costs TimeScaledData
For Each tsv In tsvsBaselineCost
idx = tsv.Index
'tsv.Value = 60 * tsv.Index
If (Weekday(tsvsBaselineWork.Item(idx).StartDate) <> 1 And _
Weekday(tsvsBaselineWork.Item(idx).StartDate) <> 7) Then
tsv.Value = AC_TBCost / (AC_TBDur / 8)
End If
Next tsv
End If
Next Temp
'Atribuindo os valores totais à tarefa de sumário do projeto
ActiveProject.ProjectSummaryTask.BaselineCost = AC_PBCost
ActiveProject.ProjectSummaryTask.BaselineWork = AC_PBWork
'Atualizando Task(Temp) no TimeScaledData
With ActiveProject.ProjectSummaryTask
Set tsvsBaselineWork = .TimeScaleData( _
StartDate:=.BaselineStart, _
EndDate:=.BaselineFinish, _
Type:=pjTaskTimescaledBaselineWork, _
TimeScaleUnit:=pjTimescaleDays, Count:=1)
End With
With ActiveProject.ProjectSummaryTask
Set tsvsBaselineCost = .TimeScaleData( _
StartDate:=.BaselineStart, _
EndDate:=.BaselineFinish, _
Type:=pjTaskTimescaledBaselineCost, _
TimeScaleUnit:=pjTimescaleDays, Count:=1)
End With
'Atualizando Baseline Work TimeScaledData
For Each tsv In tsvsBaselineWork
idx = tsv.Index
If (Weekday(tsvsBaselineWork.Item(idx).StartDate) <> 1 And _
Weekday(tsvsBaselineWork.Item(idx).StartDate) <> 7) Then
tsv.Value = AC_TBWork / AC_TBDur * 8
End If
Next tsv
'Atualizando Baseline Costs TimeScaledData
For Each tsv In tsvsBaselineCost
idx = tsv.Index
'tsv.Value = 60 * tsv.Index
If (Weekday(tsvsBaselineWork.Item(idx).StartDate) <> 1 And _
Weekday(tsvsBaselineWork.Item(idx).StartDate) <> 7) Then
tsv.Value = AC_TBCost / (AC_TBDur / 8)
End If
Next tsv
i = 1
For Each objResource In ActiveProject.Resources
objResource.BaselineCost = VT_RCost(i)
objResource.BaselineWork = VT_RWork(i)
i = i + 1
Next objResource
ErrorHandler:
If Err.Number = 91 Then
Err.Clear
Resume Next
End If
If Err.Number = 6 Then
'É um milestone, sem duração!
Err.Clear
Resume Next
End If
End Sub
