在MS Project中使用VBA对摘要任务进行颜色编码

Question

我们使用阶段门框架，并希望根据我们的颜色对每个阶段进行颜色编码。我已经让下面的代码工作了，但是，它继续循环大约30次。

虽然它不需要一直循环，但不知道如何处理。如果有任何帮助，我们将不胜感激。

每个阶段都处于第一个总结级别

Sub FindFieldByPriority2()
Dim ProjTasks   As Tasks
Dim ProjTask    As Task
Set ProjTasks = ActiveProject.Tasks
If ProjTask.Summary = True Then

Find Field:="Name", Test:="contains", Value:="STAGE 1 -"
SelectRow
Font32Ex Color:=16777215, CellColor:=50417

Find Field:="Name", Test:="contains", Value:="STAGE 2 -"
SelectRow
Font32Ex Color:=16777215, CellColor:=1597656

Find Field:="Name", Test:="contains", Value:="STAGE 3 -"
SelectRow
Font32Ex Color:=16777215, CellColor:=4925715

Find Field:="Name", Test:="contains", Value:="STAGE 4 -"
SelectRow
Font32Ex Color:=16777215, CellColor:=4898666
End If
Next ProjTask

结束子

Answer 1

此代码循环执行任务，并根据任务名称设置级别1摘要任务的格式。

Sub FormatLevel1SummaryTasks()
FilterApply "All Tasks"
SelectAll
OutlineShowAllTasks

Dim tsk As Task
For Each tsk In ActiveProject.Tasks
If Not tsk Is Nothing Then
If tsk.OutlineLevel = 1 Then

Find Field:="Unique ID", Test:="equals", Value:=tsk.UniqueID
If ActiveCell.Task.UniqueID = tsk.UniqueID Then

Select Case Left$(tsk.Name, 10)
Case Is = "STAGE 1 - "
Font32Ex Color:=16777215, CellColor:=50417
Case Is = "STAGE 2 - "
Font32Ex Color:=16777215, CellColor:=1597656
Case Is = "STAGE 3 - "
Font32Ex Color:=16777215, CellColor:=4925715
Case Is = "STAGE 4 - "
Font32Ex Color:=16777215, CellColor:=4898666
Case Else
End Select

End If
End If
End If
Next tsk

End Sub

注意：要只格式化可见任务，请删除前三行代码。

Answer 2

另一个选项是依次应用过滤器来隔离每个阶段。对过滤后的集合执行SelectAll并集体应用颜色格式。约翰·