获取任务“过度分配”（VBA）-Microsoft Project

Question

我需要在 TASK 过度分配时获取（因为一个或多个资源被过度分配）。 我已经能够获得过度分配的资源，但是由于对于应用程序来说，资源（如果过度分配）总是过度分配，所以我必须仅在特定任务的资源被过度分配时识别。

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

• 任务 #2 和 6# 被“过度分配”（因为资源“MCA”在同一天使用） --> 是的，我的警报触发
• 任务 #4 没有过度分配（没有红人）--> 没有触发器（尽管 MCA 全局过度分配）

那么，我如何识别（使用 VBA）指标列中带有红人的所有任务？

非常感谢提前 回复

Answer 1

正确的属性应该是 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