MS Project 2013:显示摘要任务的资源

Question

有没有办法配置MS Project 2013，使其在摘要任务的甘特图视图的资源列(例如，资源缩写)中显示分配给其叶部子任务的所有资源的联合。

例如，假设我有一个摘要任务S，其中包含两个子任务S1和S2，S2本身被划分为子任务S21和S22。

还可以说，我已经分配了资源R1、R2到S1、资源R2、R3到S21和资源R4到S22。

在我当前的配置中，S2和S的资源初始列都是空的。

相反，我希望S2的资源列显示R2、R3、R4，而S的资源列显示R1、R2、R3、R4。

其思想是能够可视化分配给摘要任务的所有资源，即使其在子任务中的分解是隐藏的。

提前感谢您对如何实现这一点的建议。

Answer 1

这些资源字段存在于摘要级别，因为您可以直接将资源分配给摘要任务，因此不能将这些字段用于此目的。然而，这里有一个宏，它聚合了分配给子任务的资源的名称。结果放在摘要级别的Text1中。然后，您可以修改甘特图条形图样式以显示该文本域。

Sub RollupResourceNames()

    Dim tsk As Task
    Dim list As String
    Dim key As Variant

    For Each tsk In ActiveProject.Tasks
        If tsk.Summary Then
            Dim col As New Collection
            Set col = GetChildResourceAssignments(tsk)
            list = vbNullString
            For Each key In col
                list = list & ", " & key
            Next
            If Len(list) > 2 Then
                list = Mid$(list, 3)
            End If
            tsk.Text1 = list
        End If
    Next tsk

End Sub

Function GetChildResourceAssignments(parent As Task) As Collection

    Dim col As New Collection

    Dim child As Task
    Dim asn As Assignment
    For Each child In parent.OutlineChildren
        If child.Summary Then
            Dim col2 As New Collection
            Set col2 = GetChildResourceAssignments(child)
            Dim key As Variant
            For Each key In col2
                col.Add key, key
            Next key
        End If
        For Each asn In child.Assignments
            On Error Resume Next
            col.Add asn.Resource.Name, asn.Resource.Name
            On Error GoTo 0
        Next asn
    Next child

    Set GetChildResourceAssignments = col

End Function

Answer 2

@Rachel - Solution工作得很好，除了如果你有多个级别的父/子任务，并且在不同的级别上存在相同的资源时，它会出错(错误457)。它试图将资源名称添加到集合中，但它已经存在(因为它是在脚本检查另一组任务时添加的)，并且不知道该做什么。

这可以通过添加另一个"On Error Resume Next“行来修复。这是修改后的宏，它在我的项目计划中工作得很好。把所有的功劳都归功于瑞秋·赫廷格，我只加了一行！

Sub RollupResourceNames()

    Dim tsk As Task
    Dim list As String
    Dim key As Variant

    For Each tsk In ActiveProject.Tasks
        If tsk.Summary Then
            Dim col As New Collection
            Set col = GetChildResourceAssignments(tsk)
            list = vbNullString
            For Each key In col
                list = list & ", " & key
            Next
            If Len(list) > 2 Then
                list = Mid$(list, 3)
            End If
            tsk.Text1 = list
        End If
    Next tsk

End Sub

Function GetChildResourceAssignments(parent As Task) As Collection

    Dim col As New Collection

    Dim child As Task
    Dim asn As Assignment
    For Each child In parent.OutlineChildren
        If child.Summary Then
            Dim col2 As New Collection
            Set col2 = GetChildResourceAssignments(child)
            Dim key As Variant
            For Each key In col2
                On Error Resume Next
                col.Add key, key
            Next key
        End If
        For Each asn In child.Assignments
            On Error Resume Next
            col.Add asn.Resource.Name, asn.Resource.Name
            On Error GoTo 0
        Next asn
    Next child

    Set GetChildResourceAssignments = col

End Function