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