Microsoft project - 扫描并传输任务使用情况查看数据

Question

在 Microsoft Project 2016 中，我正在编写 VBA 以从任务使用情况视图中提取单元格数据，按资源名称对数据进行分组，然后汇总每个资源的所有剩余时间和剩余成本。我使用 Traceback VBA 过程来跟踪单个目标任务中的所有前置任务。使用“已标记”标志来识别所有 未完成 前置任务应该允许我计算项目中任何任务的估计完成。到目前为止，过程设置表、过滤器和视图以在显示任务使用情况自定义视图并将数据传输到数组之前启用。

注意，从后面的调试信息来看，Traceback中有24个任务！此子中只有 2 个显示数据。

我在读取一些任务数据和一些分配数据方面取得了一些成功，但我没有得到一致的结果。调用 Create TaskUsage View 会根据当前的任务回溯创建一个新的任务使用情况视图。这是到目前为止的代码：

 Sub NewArrayLoad()

 Dim FilteredTasks As tasks
 Dim ArrayIndex As Integer, iCtr As Integer, ArrayCtr As Integer, tCtr As Integer
 Dim arrResNames() As Variant, arrResSpread As Variant, ResCt As Integer, LoopCount As Integer, 
    MyCheckn As Boolean, MyCheckA As Boolean, r As Resource, AA As Assignment


enter code here
Call CreateNewTaskUsage("TaskUsage")

ReDim arrResNames(1 To ActiveProject.Resources.Count)
Myfile = "C:\Macros\MCS.txt"

FExists (Myfile)
If FileExists = True Then
    sbDeleteAFile (Myfile)
End If

'Loads resources from project into an array
For ResCt = 1 To ActiveProject.Resources.Count
    arrResNames(ResCt) = ActiveProject.Resources(ResCt).name
    OutputStr = ("2046 - CreateProjectPDFforSRA - Resource added = " & arrResNames(ResCt))
    Call Txt_Append(Myfile, OutputStr)
Next ResCt


Set FilteredTasks = ActiveSelection.tasks
Application.SelectAll
ReDim arrResSpread(1 To ActiveSelection.tasks.Count, 1 To 4 * (ResCt - 1) + 2)
Debug.Print (" Count of tasks in selection = " & ActiveSelection.tasks.Count)

ArrayIndex = 0
ArrayCtr = 1
tCtr = 1
 
For Each t In FilteredTasks
        SelectRow row:=tCtr, RowRelative:=False, Height:=2, Add:=False
        Debug.Print ("Current Row = " & tCtr)
        ArrayIndex = ArrayIndex + 1
        arrResSpread(ArrayIndex, ArrayCtr) = ActiveSelection.tasks(tCtr).ID
        arrResSpread(ArrayIndex, ArrayCtr + 1) = ActiveSelection.tasks(tCtr).name
        Debug.Print ("1-Current Row after down = " & tCtr)
            For Each r In ActiveCell.Task.Resources
                tCtr = tCtr + 1
                For Each AA In ActiveCell.Task.Assignments
                    Debug.Print ("ArrayIndex = " & ArrayIndex & " ArrayCtr = " & ArrayCtr)
                         arrResSpread(ArrayIndex, ArrayCtr + 2) = AA.ResourceName
                         For iCtr = 1 To ResCt - 1
                            If arrResNames(iCtr) = AA.ResourceName Then
                                SelectRow row:=tCtr, RowRelative:=True, Height:=2, Add:=False
                                MyCheckn = IsNull(ResName)
                                MyCheckA = IsEmpty(ResName)
                                If MyCheckn = False Or MyCheckA = False Then
                              
                                    '   Debug.Print "2-t.id=" & ActiveSelection.tasks(tCtr).ID & " t.name= " & ActiveSelection.tasks(tCtr).name
                                    arrResSpread(ArrayIndex, ArrayCtr + 2) = AA.ResourceName
                                    arrResSpread(ArrayIndex, ArrayCtr + 2 + iCtr) = AA.Work / 60
                                    arrResSpread(ArrayIndex, ArrayCtr + 3 + iCtr) = AA.RemainingWork / 60
                                    arrResSpread(ArrayIndex, ArrayCtr + 4 + iCtr) = AA.Cost
                                    arrResSpread(ArrayIndex, ArrayCtr + 5 + iCtr) = AA.RemainingCost
                                    Debug.Print ("2-Current Row after down = " & tCtr)
                                    Debug.Print ("ICtr=" & iCtr & " ResName=" & AA.ResourceName & " AA.Work= " & AA.RemainingWork / 60 & " RemCost=" & AA.RemainingCost)
                                tCtr = tCtr + 1
                             
                                End If
                               Debug.Print arrResSpread(ArrayIndex, 1) & "-" & arrResSpread(ArrayIndex, 2) & "-" & arrResSpread(ArrayIndex, 3) & "-" & arrResSpread(ArrayIndex, 4) & "-" _
                                & arrResSpread(ArrayIndex, 5) & "-" & arrResSpread(ArrayIndex, 6) & "-" & arrResSpread(ArrayIndex, 7) & "-" & arrResSpread(ArrayIndex, 8) & "-" & arrResSpread(ArrayIndex, 9) & "-" & arrResSpread(ArrayIndex, 10)
                                    
                            End If
                        Next iCtr
                        ArrayIndex = ArrayIndex + 1
                    Next AA
                    ArrayIndex = ArrayIndex + 1
            Next r
Next t

End Sub

我在以下方面遇到问题： -读取任务段数据，即第一个任务之后的任何任务的 Task.ID 和 Task.Name - 阅读 1st 2 任务以外的作业。我似乎无法辨别当我前进一行时，“ID”列是否包含新任务ID，这应该有一个新的数组任务条目以及何时退出添加新任务。

来自运行代码的示例调试数据。

请注意，任务 284 已按需要读取并加载到阵列中。任务 285 被跳过，任务 286 只包含分配数据，没有任务 ID 或名称。到最后的第287个任务根本没有被拾取。

我知道我没有像我想的那样正确地逐行阅读信息，任务 ID 和任务名称似乎以不同于分配数据的方式访问任务使用情况上的数据。我无法发出提取任务 ID 的请求，例如，当我也在访问作业时。

一个解决方案可能是将任务使用情况视图简单地导出到 excel，我可以在其中解析数据，但我试图避免必须使用 excel 作为中介。你有什么建议吗？

Answer 1

I am having issues in : -Reading the task segment data i.e, the Task.ID and the Task.Name for any task after the 1st task -Reading the assignments beyond the 1st 2 tasks. I appear to be unable to discern that when I advance a row, whether the "ID" column contains a New task ID, and this should have a new array task entry and when to exit adding new assignments.

是的，通过从视图中选择值来读取值很容易遇到挑战。更好的方法是使用对象模型逐步遍历 'rows' 和字段。在这种情况下，行是任务及其分配的混合。

我修改了代码以循环遍历任务集合对象，FilteredTasks，并为每个任务循环遍历其分配：

Sub NewArrayLoad()

Dim FilteredTasks As Tasks
Dim ArrayIndex As Integer, ArrayCtr As Integer
Dim arrResNames() As Variant, arrResSpread As Variant, ResCt As Integer
Dim AA As Assignment
Dim OutputStr As String

ReDim arrResNames(1 To ActiveProject.Resources.Count)

Dim Myfile As String
Myfile = "C:\Macros\MCS.txt"
If Dir(Myfile) <> "" Then
    Kill Myfile
End If

'Loads resources from project into an array
For ResCt = 1 To ActiveProject.Resources.Count
    arrResNames(ResCt) = ActiveProject.Resources(ResCt).Name
    OutputStr = ("2046 - CreateProjectPDFforSRA - Resource added = " & arrResNames(ResCt))
    Call Txt_Append(Myfile, OutputStr)
Next ResCt

Set FilteredTasks = ActiveSelection.Tasks
ReDim arrResSpread(1 To FilteredTasks.Count, 1 To 5 * (ResCt - 1) + 2)

ArrayIndex = 0
 
Dim t As Task
For Each t In FilteredTasks
    
    ArrayIndex = ArrayIndex + 1
    arrResSpread(ArrayIndex, 1) = t.ID
    arrResSpread(ArrayIndex, 2) = t.Name
        
    For Each AA In t.Assignments
    
        ArrayCtr = AA.Resource.ID
        arrResSpread(ArrayIndex, 2 + (ArrayCtr - 1) * 5 + 1) = AA.ResourceName
        arrResSpread(ArrayIndex, 2 + (ArrayCtr - 1) * 5 + 2) = AA.Work / 60
        arrResSpread(ArrayIndex, 2 + (ArrayCtr - 1) * 5 + 3) = AA.RemainingWork / 60
        arrResSpread(ArrayIndex, 2 + (ArrayCtr - 1) * 5 + 4) = AA.Cost
        arrResSpread(ArrayIndex, 2 + (ArrayCtr - 1) * 5 + 5) = AA.RemainingCost
            
        Dim i As Integer, s As String
        s = vbNullString
        For i = 1 To UBound(arrResSpread, 2)
            s = s & "-" & arrResSpread(ArrayIndex, i)
        Next i
        Debug.Print Mid$(s, 2)
                   
    Next AA
Next t

' presumably arrResSpread is written out to the Myfile at this point

End Sub

Answer 2

非常感谢您的帮助。您的修改让我完成了 90% 的工作。我仍然需要对您的代码进行一些修改，因为声明“For Each t In FilteredTasks”对我不起作用。我必须用“for each t in ActiveSelection.tasks”替换并添加附加语句“Application.SelectAll”，因为没有这个附加语句，只选择了 1 个任务，而不是过滤后的任务使用情况视图。非常感谢您如此快速地查看问题。

Microsoft project - 扫描并传输任务使用情况查看数据

Microsoft project -Scan and transfer Task Usage View data

parsing

vba

ms-project