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