OutlineShowAllTasks generating runtime error 1100 VBA MS Project

Question

I'm helping my dad out with some of his work on an MS project plan and I've written this macro which will refresh all tasks in an MS project plan to their needed value. Apparently recently the Project plan started acting up and giving a runtime error 1100 on OutlineShowAllTasks (this hasn't happened before). Do you think this is a problem in the logic of the code or could it be due to the volume of the project plan? Code is below. Thanks again for any help in advance.

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

Rachel Hettinger Rachel Hettinger · Accepted Answer · 2015-08-25T22:27:52

It sounds like the Active View is not a task view (e.g. the Resource Sheet is showing) and therefore the OutlineShowAllTasks command fails. Here's a procedure you can use to first make sure the active view is a task view. Call this procedure before you call the OutlineShowAllTasks command.

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

OutlineShowAllTasks generating runtime error 1100 VBA MS Project

2 Answers