项目时间缩放数据 VBA 使用



使用API,我希望用来自pjTaskTimescaledBaselineRemainingTasks的一些时间缩放数据填充一个spead表。

我想浏览 prject 和拉取日期、pjTaskTimescaledBaselineRemainingTasks、pjTaskTimescaledRemainingTasks 和 pjTaskTimescaledRemainingActualTasks,以便我可以创建一个燃尽图。

最初,我虽然pjTaskTimescaledBaselineRemainingTasks是application.resources对象的一部分,但现在我不太确定。

我知道。开始(我在同一张纸上也需要(是application.tasks的一部分。

我认为这是失败的,因为我没有正确处理该字段,即它不是 T.PjTaskTimescaledData.pjTaskTimescaledBaselineRemainingTasks。

任何人都可以提供帮助,因为我已经查看了 api 文档,但还没有完全了解这个嵌套是如何工作的?

谢谢

地球人

Set Pj = ActiveProject
For Each T In Pj.Tasks
XlSheet.Cells(i, 2).Value = T.Start
XlSheet.Cells(i, 3).Value = T.PjTaskTimescaledData(pjTaskTimescaledBaselineRemainingTasks)
Next T

根据马尔科姆的反馈更新代码

Sub GetFinishesPerDay()
'Malcolm Farrelle
Const DateValue = 0
Const BLFinish = 1
Const FFinish = 2
Const ACFinish = 3
Dim TaskFinishes() As Date
Dim FinishesPerDate() As Variant
Dim t As Task
Dim p As Project
Dim x As Integer
Dim startdt As Date
Dim finishdt As Date
Dim dt As Date
Dim ThisIndex As Integer
ReDim TaskFinishes(4, 0)
ReDim FinishesPerDate(3, 0)
Set p = ActiveProject
startdt = p.Finish
finishdt = p.Start
Set XlSheet = xlBook.Worksheets("Burndown_Data")
XlSheet.Activate
xlApp.StatusBar = "Updating Burndown Data"
'and the column headings in row 2
XlSheet.Cells(2, 2).Value = "Date"
XlSheet.Cells(3, 2).Value = "Baseline Remaining Tasks" 'BLFinish
XlSheet.Cells(4, 2).Value = "Remaining Tasks" 'FFinish
XlSheet.Cells(5, 2).Value = "Remaining Actual Tasks"

i = 3
'Malcolm Farrelle
For Each t In p.Tasks
If Not t Is Nothing Then
'Do not consider any "blank lines" in the project, these are not actually tasks and code will fail
If Not t.Summary Then
'Check the finish and baselinefinish dates and set the "startdt" and "finishdt"
'variables with the earliest start and latest finish of the whole data set
If t.Finish < startdt Then startdt = t.Finish
If t.Finish > finishdt Then finishdt = t.Finish
If t.BaselineFinish <> "NA" Then
If t.BaselineFinish < startdt Then startdt = t.BaselineFinish
If t.BaselineFinish > finishdt Then finishdt = t.BaselineFinish
End If
'Consider only non-summary tasks - if required add another check to exclude milestones
ThisIndex = UBound(TaskFinishes, 2) + 1
ReDim Preserve TaskFinishes(3, ThisIndex)
If t.BaselineFinish <> "NA" Then TaskFinishes(BLFinish, ThisIndex) = t.BaselineFinish
TaskFinishes(FFinish, ThisIndex) = t.Finish
If t.ActualFinish <> "NA" Then TaskFinishes(ACFinish, ThisIndex) = t.ActualFinish
End If
End If
Next t

'construct an array of Finishes and Baseline Finishes per date
For dt = Format(startdt, "dd/mmm/yy") To Format(finishdt, "dd/mmm/yy")
'Using "Format" removes the "HH:MM" component of the itterating "dt" date
ThisIndex = UBound(FinishesPerDate, 2) + 1
ReDim Preserve FinishesPerDate(4, ThisIndex)
FinishesPerDate(FFinish, ThisIndex) = 0
FinishesPerDate(BLFinish, ThisIndex) = 0
FinishesPerDate(ACFinish, ThisIndex) = 0
For x = 1 To UBound(TaskFinishes, 2)
FinishesPerDate(DateValue, ThisIndex) = dt
If TaskFinishes(BLFinish, x) <> 0 Then
'task (i) has a baseline finish
If TaskFinishes(BLFinish, x) >= dt And TaskFinishes(BLFinish, x) < dt + 1 Then
'and it finishes on date "dt"
FinishesPerDate(BLFinish, ThisIndex) = FinishesPerDate(BLFinish, ThisIndex) + 1
End If
End If
If TaskFinishes(FFinish, x) >= dt And TaskFinishes(FFinish, x) < dt + 1 Then
FinishesPerDate(FFinish, ThisIndex) = FinishesPerDate(FFinish, ThisIndex) + 1
End If
Next x
Next dt
Set p = Nothing

'Preview the data
For x = 1 To UBound(FinishesPerDate, 2)
Debug.Print FinishesPerDate(DateValue, x), "BL: " & FinishesPerDate(BLFinish, x), "FF: " & FinishesPerDate(FFinish, x)
'control/g

XlSheet.Cells(2, i).Value = FinishesPerDate(DateValue, x)
XlSheet.Cells(3, i).Value = FinishesPerDate(BLFinish, x)
XlSheet.Cells(4, i).Value = FinishesPerDate(FFinish, x)
XlSheet.Cells(5, i).Value = FinishesPerDate(ACFinish, x)
i = i + 1
Next x
End Sub

悬念要了我的命。 我不确定OP想要什么,所以我做了一个猜测。 如果OP想知道"在最早(预测([完成]或[基线完成]日期与最晚(Foreacast([完成]或[基线完成]日期之间的每一天完成和预计完成的任务数量",则应补充以下内容。 (OP中的时间尺度数据是深红色的kipper(:

Sub GetFinishesPerDay()
'Malcolm Farrelle
Const DateValue = 0
Const BLFinish = 1
Const FFinish = 2
Dim TaskFinishes() As Date
Dim FinishesPerDate() As Variant
Dim t As Task
Dim p As Project
Dim i As Integer
Dim startdt As Date
Dim finishdt As Date
Dim dt As Date
Dim ThisIndex As Integer
ReDim TaskFinishes(2, 0)
ReDim FinishesPerDate(3, 0)
Set p = ActiveProject
startdt = p.Finish
finishdt = p.Start
For Each t In p.Tasks
If Not t Is Nothing Then
'Do not consider any "blank lines" in the project, these are not actually tasks and code will fail
If Not t.Summary Then
'Check the finish and baselinefinish dates and set the "startdt" and "finishdt"
'variables with the earliest start and latest finish of the whole data set
If t.Finish < startdt Then startdt = t.Finish
If t.Finish > finishdt Then finishdt = t.Finish
If t.BaselineFinish <> "NA" Then
If t.BaselineFinish < startdt Then startdt = t.BaselineFinish
If t.BaselineFinish > finishdt Then finishdt = t.BaselineFinish
End If
'Consider only non-summary tasks - if required add another check to exclude milestones
ThisIndex = UBound(TaskFinishes, 2) + 1
ReDim Preserve TaskFinishes(2, ThisIndex)
If t.BaselineFinish <> "NA" Then TaskFinishes(BLFinish, ThisIndex) = t.BaselineFinish
TaskFinishes(FFinish, ThisIndex) = t.Finish
End If
End If
Next t
'construct an array of Finishes and Baseline Finishes per date
For dt = Format(startdt, "dd/mmm/yy") To Format(finishdt, "dd/mmm/yy")
'Using "Format" removes the "HH:MM" component of the itterating "dt" date
ThisIndex = UBound(FinishesPerDate, 2) + 1
ReDim Preserve FinishesPerDate(3, ThisIndex)
FinishesPerDate(FFinish, ThisIndex) = 0
FinishesPerDate(BLFinish, ThisIndex) = 0
For i = 1 To UBound(TaskFinishes, 2)
FinishesPerDate(DateValue, ThisIndex) = dt
If TaskFinishes(BLFinish, i) <> 0 Then
'task (i) has a baseline finish
If TaskFinishes(BLFinish, i) >= dt And TaskFinishes(BLFinish, i) < dt + 1 Then
'and it finishes on date "dt"
FinishesPerDate(BLFinish, ThisIndex) = FinishesPerDate(BLFinish, ThisIndex) + 1
End If
End If
If TaskFinishes(FFinish, i) >= dt And TaskFinishes(FFinish, i) < dt + 1 Then
FinishesPerDate(FFinish, ThisIndex) = FinishesPerDate(FFinish, ThisIndex) + 1
End If
Next i
Next dt
Set p = Nothing
'Preview the data
For i = 1 To UBound(FinishesPerDate, 2)
Debug.Print FinishesPerDate(DateValue, i), "BL: " & FinishesPerDate(BLFinish, i), "FF: " & FinishesPerDate(FFinish, i)
Next i
End Sub

最新更新