OutlineShowAllTask​​s生成运行时错误1100 VBA MS Project

Question

我帮助我的父亲完成了他在MS项目计划上的一些工作，并且我已经编写了这个宏，它将MS项目计划中的所有任务刷新到他们所需的价值。显然，最近项目计划开始起作用并在OutlineShowAllTask​​s上发出运行时错误1100（之前没有发生过）。您认为这是代码逻辑中的问题还是可能是由于项目计划的数量？代码如下。再次感谢您的任何帮助。

Sub RefreshTaskStatus()
Dim tsks As Tasks
Dim t As Task
Dim rgbColor As Long
Dim predCount As Integer
Dim predComplete As Integer
Dim time As Date

time = Now()

OutlineShowAllTasks
FilterApply "All Tasks"

Set tsks = ActiveProject.Tasks

For Each t In tsks
    ' We do not need to worry about the summary tasks
    If (Not t Is Nothing) And (t.Summary) Then
        SelectRow Row:=t.ID, RowRelative:=False
        Font32Ex CellColor:=&HFFFFFF
    End If

    If t.PercentComplete = "100" Then
        'Font32Ex CellColor:=&HCCFFCC
        SetTaskField Field:="Text11", Value:="Completed", TaskID:=t.ID
    End If

    ready = False

    If (Not t Is Nothing) And (Not t.Summary) And (t.PercentComplete <> "100") Then
        SelectTaskField Row:=t.ID, Column:="Name", RowRelative:=False
        rgbColor = ActiveCell.CellColorEx
        pcount = 0
        pcompl = 0

        For Each tPred In t.PredecessorTasks  'looping through the predecessor tasks
                pcount = pcount + 1
                percomp = tPred.PercentComplete
                If percomp = "100" Then pcompl = pcompl + 1
        Next tPred

            If pcount = 0 Then
                    ready = True
            Else
                If pcompl = pcount Then
                    ready = True
                 Else
                    ready = False
                 End If
            End If
            If (ready) Then
                'Font32Ex CellColor:=&HF0D9C6
                SetTaskField Field:="Text11", Value:="Ready", TaskID:=t.ID
                If (t.Text12 = "Yes") Then
                    SetTaskField Field:="Text11", Value:="In Progress", TaskID:=t.ID
                End If

                If t.Text11 = "In Progress" And t.Finish < time Then
                    SetTaskField Field:="Text11", Value:="Late / Overdue", TaskID:=t.ID
                End If

            Else

                'Font32Ex CellColor:=&HFFFFFF
                SetTaskField Field:="Text11", Value:="Not Ready",      TaskID:=t.ID
            End If
        End If
    Next t



End Sub

Answer 1

听起来Active View不是任务视图（例如资源表正在显示），因此OutlineShowAllTasks命令失败。这是一个可用于首先确保活动视图是任务视图的过程。在调用OutlineShowAllTasks命令之前调用此过程。

Sub EnsureTaskView()

    Const GanttView As String = "Gantt Chart"

    If ActiveWindow.ActivePane.Index <> 1 Then
        ActiveWindow.TopPane.Activate
    End If

    With ActiveProject
        Dim CurView As String
        CurView = .CurrentView

        Dim IsTaskView As Boolean
        Dim HasGanttView As Boolean

        ' loop through all TASK views to see if this is one of them (as opposed to a resource view)
        Dim View As Variant
        For Each View In .TaskViewList
            IsTaskView = IsTaskView Or (View = CurView)
            HasGanttView = HasGanttView Or (View = GanttView)
        Next View

        If Not IsTaskView Then
            If HasGanttView Then
                ViewApply (GanttView)
            Else
                ViewApply (ActiveProject.TaskViewList.Item(1))
            End If
        End If
    End With

End Sub

Answer 2

如果未首先按ID排序文件，

OutlineShowAllTasks也将崩溃。一个简单的解决方法是添加一行，以ID号对项目进行排序。