获取任务 "OVERALLOCATED" (VBA) - Microsoft Project

Get TASK "OVERALLOCATED" (VBA) - Microsoft Project

我需要了解 TASK 何时被过度分配(因为一个或多个资源被过度分配)。 我已经能够获得过度分配的资源,但由于对于应用程序来说,资源(如果过度分配)总是过度分配,所以我必须 仅当特定任务 的资源被过度分配时才需要识别。

我的意思是,指标栏中的红人正是我想要得到的:

那么,如何识别(使用VBA)指标栏中所有带有红人的任务?

非常感谢 R

正确的 属性 应该是 Task.Overallocated,但它似乎不起作用——该值始终为 False(或在甘特图视图中显示为“否”)。

解决方法是使用 Resource.Overallocated 属性 循环遍历资源(这确实有效),然后循环遍历过度分配资源的分配以找到超出的任务-分配天数。

注意:重要的是在资源级别获取 TimeScaleValues 的集合以获得每天分配给该资源的总数(例如,使用 Set tsvs = res.TimeScaleData... 而不是 Set tsvs = asn.TimeScaleData... ).

Sub FindOverAllocatedTasks()

    Dim overAllocTasks As New Collection
    
    Dim res As Resource
    For Each res In ActiveProject.Resources
        If res.overAllocated Then
            
            Dim maxMinutes As Double
            maxMinutes = res.MaxUnits * 60 * ActiveProject.HoursPerDay
            
            Dim asn As Assignment
            For Each asn In res.Assignments
            
                Dim tsvs As TimeScaleValues
                Set tsvs = res.TimeScaleData(asn.Start, asn.Finish, pjResourceTimescaledWork, pjTimescaleDays)
                Dim tsv As TimeScaleValue
                For Each tsv In tsvs
                    If VarType(tsv.Value) = vbDouble Then
                        If tsv.Value > maxMinutes Then
                            If Not Contains(overAllocTasks, CStr(asn.Task.UniqueID)) Then
                                overAllocTasks.Add asn.Task, CStr(asn.Task.UniqueID)
                            End If
                        End If
                    End If
                Next tsv
            
            Next asn
            
        End If
    Next res

    MsgBox overAllocTasks.Count
    
End Sub

Public Function Contains(col As Collection, key As Variant) As Boolean
Dim obj As Variant
On Error GoTo err
    Contains = True
    obj = col(key)
    Exit Function
err:

    Contains = False
End Function