OutlineShowAllTasks генерирует ошибку времени выполнения 1100 VBA MS Project

Question

Я помогаю моему отцу выполнить некоторые из его работ по плану проекта MS, и я написал этот макрос, который обновит все задачи в плане проекта MS до их необходимого значения. По-видимому, недавно план проекта начал действовать и дал ошибку 1100 времени выполнения в OutlineShowAllTasks (этого раньше не было). Считаете ли вы, что это проблема в логике кода или это может быть связано с объемом плана проекта? Код ниже. Еще раз спасибо за любую помощь заранее.

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