有没有办法配置MS Project 2013,以便它显示在摘要任务的甘特图视图的资源列(例如,资源首字母)中,分配给其叶子任务的所有资源的UNION。
比如说我有一个带有2个子任务S1&的摘要任务S. S2,S2本身分为子任务S21和S2。 S22。
另请注意,我已将资源R1,R2分配给S1,资源R2,R3分配给S21,资源R4分配给S22。
使用我当前的配置,S2和S的资源初始列都留空。
相反,我希望S2的资源列显示R2,R3,R4和S的资源列,以显示R1,R2,R3,R4。
这个想法是能够可视化分配给摘要任务的所有资源,即使它隐藏了子任务中的分解。
非常感谢您提供有关如何实现这一目标的建议。
答案 0 :(得分: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
答案 1 :(得分:0)
@Rachel Hettinger - 解决方案效果很好,但如果您有多个级别的父/子任务并且相同的资源存在于不同级别,则会出错(错误457)。它尝试将资源名称添加到集合中,但它已经存在(因为它是在脚本检查其他任务集时之前添加的)并且不知道该怎么做。
只需添加另一个“On Error Resume Next”行即可解决此问题。这是修改后的宏,它完全适用于我的项目计划。 所有归功于Rachel Hettinger ,我只是添加了一行!
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