项目宏退出而不删除所有相关任务

时间:2017-07-18 20:46:38

标签: microsoft-project-vba

我有一个宏用于删除所有工作量为零的任务,如果它们是a)不是关键里程碑(企业定义字段)或b)大于概要级别1。

然而,宏退出并且不再继续执行满足上述标准的所有任务。项目计划非常冗长(大约1840行),它在200行左右停止。看来宏不会循环完成所有相关任务,但我无法弄清楚原因。

Sub DeleteMsProjectTask()
Dim proj As Project
Dim t As Task
Dim tsk
Dim mileTsk
Set proj = ActiveProject
For Each t In proj.Tasks
If t.OutlineLevel > 1 And t.Work = 0 Then
   tsk = t.Name
   mileTsk = t.GetField(FieldNameToFieldConstant("Key Milestone?", pjTask))
   If mileTsk = "No" Then
        t.Delete
   Else
   End If
End If
Next t
MsgBox ("Done")
End Sub

1 个答案:

答案 0 :(得分:1)

<强>已更新

代码已更新,以便从子项目中删除任务。

正如Shai Rado所说,关键是使用索引循环遍历集合而不是遍历集合。

Sub DeleteMsProjectTask()
    DeleteTasks ActiveProject
    Dim sp As Subproject
    For Each sp In ActiveProject.Subprojects
        DeleteTasks sp.SourceProject
    Next sp
End Sub

Sub DeleteTasks(prj As Project)
    Dim NumTasks As Integer
    NumTasks = prj.Tasks.Count
    Dim idx As Integer
    idx = NumTasks
    Dim t As Task
    Dim mileTsk As String
    Do While idx > 0
        Set t = prj.Tasks(idx)
        If t.OutlineLevel > 1 And t.Work = 0 Then
            mileTsk = t.GetField(FieldNameToFieldConstant("Key Milestone?", pjTask))
            If mileTsk = "No" Then
                t.Delete
                NumTasks = NumTasks - 1
            End If
        End If
        idx = idx - 1
    Loop
End Sub