OutlineShowAllTasks 生成运行时错误 1100 VBA MS 项目答案

【问题标题】：OutlineShowAllTasks generating runtime error 1100 VBA MS ProjectOutlineShowAllTasks 生成运行时错误 1100 VBA MS 项目
【发布时间】：2022-03-21 17:17:17
【问题描述】：

我正在帮助我父亲完成 MS 项目计划中的一些工作，我编写了这个宏，它将刷新 MS 项目计划中的所有任务，使其达到所需的值。显然，最近项目计划开始执行并在 OutlineShowAllTasks 上给出运行时错误 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

【问题讨论】：

标签： vba ms-project

【解决方案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

【讨论】：

【解决方案2】：

OutlineShowAllTasks 如果文件没有先按 ID 排序也会崩溃。一个简单的解决方法是添加一行按 ID 号对项目进行排序。

【讨论】：

【解决方案3】：

实际的解决方案要容易得多。您需要处于活动摘要任务的视图中，否则您无法展开组。所以解决方法是将“SummaryTasksShow”设置为“True”，然后展开，然后用“False”反转视图

SummaryTasksShow (True)

OutlineShowAllTasks

SummaryTasksShow (False)

【讨论】：