Макро-цвет Сводка Задачи работают на 90%, не могут понять, почему они не работают на 100%

Question

Приведенный ниже код работает, только если все сводные задачи полностью раскрыты. Если какая-либо из Сводных задач свернута, ошибки кода.

Я не знаю, что даже попытаться исправить эту проблему.

 Sub ColorSummaryTasks()
 Dim t As Task
 Dim i As Integer

 i = 1
 For Each t In ActiveProject.Tasks

     If t.Summary Then

         SelectRow row:=i, rowrelative:=False

         Select Case t.OutlineLevel
             Case 1
             Font32Ex CellColor:=&H1099FF   'Hex code needs to be reversed
             Case 2
             Font32Ex CellColor:=&HFF9900
             Case 3
             Font32Ex CellColor:=&H66FF66
             Case 4
             Font32Ex CellColor:=&H10CC99
             Case 5
             Font32Ex CellColor:=&HDD3377
             Case 6
             Font32Ex CellColor:=&HFF00FF

         End Select

     End If

 i = i + 1
 Next t
 End Sub

Ожидаемый результат для кода:работать независимо от того, расширены ли сводные задачи. Происходит следующее: если в сводной задаче есть 3 свернутых строки, то следующие 3 не свернутые строки не будут окрашены, независимо от того, являются они суммарными задачами или нет. Ссылка Imgur показывает, что происходит, когда макросы запускаются с суммарными задачами, как свернутыми, так и открытыми. https://imgur.com/a/3stezhQ

Answer 1

Проблема связана с тем, что код выполняет циклическое выполнение задач двумя различными способами. Цикл по коллекции задач будет проходить через каждую задачу независимо от того, видна она или нет. Использование метода SelectRow работает на только видимые задачи .

Самый простой способ синхронизировать эти два метода - начать с показа всехзадачи. Поместите этот код перед циклом *:

FilterApply "All Tasks"
SelectAll
OutlineShowAllTasks
SelectBeginning

* Обратите внимание, что это предполагает, что представление задачи активно, а для параметра Group By установлено значение [Без группы].

В качестве альтернативы вы можете выбратьнужную задачу, используя метод Find , а не SelectRow. К вашему сведению: это позволит пропустить сводные задачи, которые не отображаются.

Sub ColorSummaryTasks()
 Dim t As Task

 For Each t In ActiveProject.Tasks

     If t.Summary Then

         Find Field:="Unique ID", Test:="equals", Value:=t.UniqueID
         If ActiveCell.Task.UniqueID = t.UniqueID Then

             Select Case t.OutlineLevel
                 ' code here
             End Select

        End If

     End If

 Next t
 End Sub