Microsoft Project - сканирование и передача данных Использование задач Просмотр данных

Question

В Microsoft Project 2016 я пишу VBA для извлечения данных ячеек из представления использования задачи, группируя данные по имени ресурса, а затем суммируя все оставшиеся часы и оставшиеся затраты для каждого ресурса. Я использую процедуру Traceback VBA для отслеживания всех предшественников из одной целевой задачи. Использование флажка «отмечен» для определения всех задач, которые являются незавершенными предшественниками, должно позволить мне вычислить оценки к завершению для любой задачи в проекте. Процедура до сих пор настраивает таблицы, фильтры и представление, чтобы включить их перед отображением настраиваемого представления использования задачи и передачей данных в массив.

Обратите внимание, что из отладочной информации, представленной позже, в Traceback! Только 2 отображают данные в этом Sub.

I have had some success in reading some of the task data and some of the assignment data, but I have not had consistent results. The call Create TaskUsage View creates a new Task Usage view based on the current traceback of tasks. Here is the code so far:

 Sub NewArrayLoad()

 Dim FilteredTasks As tasks
 Dim ArrayIndex As Integer, iCtr As Integer, ArrayCtr As Integer, tCtr As Integer
 Dim arrResNames() As Variant, arrResSpread As Variant, ResCt As Integer, LoopCount As Integer, 
    MyCheckn As Boolean, MyCheckA As Boolean, r As Resource, AA As Assignment


enter code here
Call CreateNewTaskUsage("TaskUsage")

ReDim arrResNames(1 To ActiveProject.Resources.Count)
Myfile = "C:\Macros\MCS.txt"

FExists (Myfile)
If FileExists = True Then
    sbDeleteAFile (Myfile)
End If

'Loads resources from project into an array
For ResCt = 1 To ActiveProject.Resources.Count
    arrResNames(ResCt) = ActiveProject.Resources(ResCt).name
    OutputStr = ("2046 - CreateProjectPDFforSRA - Resource added = " & arrResNames(ResCt))
    Call Txt_Append(Myfile, OutputStr)
Next ResCt


Set FilteredTasks = ActiveSelection.tasks
Application.SelectAll
ReDim arrResSpread(1 To ActiveSelection.tasks.Count, 1 To 4 * (ResCt - 1) + 2)
Debug.Print (" Count of tasks in selection = " & ActiveSelection.tasks.Count)

ArrayIndex = 0
ArrayCtr = 1
tCtr = 1
 
For Each t In FilteredTasks
        SelectRow row:=tCtr, RowRelative:=False, Height:=2, Add:=False
        Debug.Print ("Current Row = " & tCtr)
        ArrayIndex = ArrayIndex + 1
        arrResSpread(ArrayIndex, ArrayCtr) = ActiveSelection.tasks(tCtr).ID
        arrResSpread(ArrayIndex, ArrayCtr + 1) = ActiveSelection.tasks(tCtr).name
        Debug.Print ("1-Current Row after down = " & tCtr)
            For Each r In ActiveCell.Task.Resources
                tCtr = tCtr + 1
                For Each AA In ActiveCell.Task.Assignments
                    Debug.Print ("ArrayIndex = " & ArrayIndex & " ArrayCtr = " & ArrayCtr)
                         arrResSpread(ArrayIndex, ArrayCtr + 2) = AA.ResourceName
                         For iCtr = 1 To ResCt - 1
                            If arrResNames(iCtr) = AA.ResourceName Then
                                SelectRow row:=tCtr, RowRelative:=True, Height:=2, Add:=False
                                MyCheckn = IsNull(ResName)
                                MyCheckA = IsEmpty(ResName)
                                If MyCheckn = False Or MyCheckA = False Then
                              
                                    '   Debug.Print "2-t.id=" & ActiveSelection.tasks(tCtr).ID & " t.name= " & ActiveSelection.tasks(tCtr).name
                                    arrResSpread(ArrayIndex, ArrayCtr + 2) = AA.ResourceName
                                    arrResSpread(ArrayIndex, ArrayCtr + 2 + iCtr) = AA.Work / 60
                                    arrResSpread(ArrayIndex, ArrayCtr + 3 + iCtr) = AA.RemainingWork / 60
                                    arrResSpread(ArrayIndex, ArrayCtr + 4 + iCtr) = AA.Cost
                                    arrResSpread(ArrayIndex, ArrayCtr + 5 + iCtr) = AA.RemainingCost
                                    Debug.Print ("2-Current Row after down = " & tCtr)
                                    Debug.Print ("ICtr=" & iCtr & " ResName=" & AA.ResourceName & " AA.Work= " & AA.RemainingWork / 60 & " RemCost=" & AA.RemainingCost)
                                tCtr = tCtr + 1
                             
                                End If
                               Debug.Print arrResSpread(ArrayIndex, 1) & "-" & arrResSpread(ArrayIndex, 2) & "-" & arrResSpread(ArrayIndex, 3) & "-" & arrResSpread(ArrayIndex, 4) & "-" _
                                & arrResSpread(ArrayIndex, 5) & "-" & arrResSpread(ArrayIndex, 6) & "-" & arrResSpread(ArrayIndex, 7) & "-" & arrResSpread(ArrayIndex, 8) & "-" & arrResSpread(ArrayIndex, 9) & "-" & arrResSpread(ArrayIndex, 10)
                                    
                            End If
                        Next iCtr
                        ArrayIndex = ArrayIndex + 1
                    Next AA
                    ArrayIndex = ArrayIndex + 1
            Next r
Next t

End Sub

I am having issues in : -Reading the task segment data i.e, the Task.ID and the Task.Name for any task after the 1st task -Reading the assignments beyond the 1st 2 tasks. I appear to be unable to discern that when I advance a row, whether the "ID" column contains a New task ID, and this should have a new array task entry and when to exit adding new assignments.

Example Debug data from running the code. Данные отладки

Обратите внимание, что задача 284 была прочитана и загружена в массив по желанию. Задача 285 была пропущена, а задача 286 содержит только данные о назначении, без идентификатора или имени задачи. Задачи 287 до конца не были взяты вообще.

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

Решением может быть простой экспорт представления использования задачи в Excel, где я могу анализировать данные, но я Я пытаюсь избежать использования Excel в качестве посредника. Есть ли у вас предложения?

Answer 1

Большое спасибо за вашу помощь. Ваша модификация досталась мне на 90% пути. Мне все же пришлось внести несколько изменений в ваш код, так как утверждение «Для каждого t в отфильтрованных задачах» у меня не сработало. Мне пришлось заменить «для каждого t в ActiveSelection.tasks» и добавить дополнительный оператор «Application.SelectAll», поскольку без этого дополнительного оператора была выбрана только 1 задача, а не отфильтрованное представление «Использование задачи». Спасибо, что так быстро ответили на вопрос.

Answer 2

У меня возникают проблемы: -Чтение данных сегмента задачи, то есть Task.ID и Task.Name для любой задачи после 1-й задачи -Чтение назначений за пределами первых 2-х задач. Кажется, я не могу понять, когда я продвигаю строку, содержит ли столбец «ID» новый идентификатор задачи, и в нем должна быть новая запись задачи массива и когда нужно выйти из добавления новых назначений.

Да, чтение значений путем выбора их из представления может быть затруднено. Лучший способ - использовать объектную модель для пошагового просмотра «строк» ​​и полей. В этом случае строки представляют собой смесь задач и их назначений.

Я изменил код на l oop через объект коллекции задач, FilteredTasks, и для каждой задачи на l oop через его назначения:

Sub NewArrayLoad()

Dim FilteredTasks As Tasks
Dim ArrayIndex As Integer, ArrayCtr As Integer
Dim arrResNames() As Variant, arrResSpread As Variant, ResCt As Integer
Dim AA As Assignment
Dim OutputStr As String

ReDim arrResNames(1 To ActiveProject.Resources.Count)

Dim Myfile As String
Myfile = "C:\Macros\MCS.txt"
If Dir(Myfile) <> "" Then
    Kill Myfile
End If

'Loads resources from project into an array
For ResCt = 1 To ActiveProject.Resources.Count
    arrResNames(ResCt) = ActiveProject.Resources(ResCt).Name
    OutputStr = ("2046 - CreateProjectPDFforSRA - Resource added = " & arrResNames(ResCt))
    Call Txt_Append(Myfile, OutputStr)
Next ResCt

Set FilteredTasks = ActiveSelection.Tasks
ReDim arrResSpread(1 To FilteredTasks.Count, 1 To 5 * (ResCt - 1) + 2)

ArrayIndex = 0
 
Dim t As Task
For Each t In FilteredTasks
    
    ArrayIndex = ArrayIndex + 1
    arrResSpread(ArrayIndex, 1) = t.ID
    arrResSpread(ArrayIndex, 2) = t.Name
        
    For Each AA In t.Assignments
    
        ArrayCtr = AA.Resource.ID
        arrResSpread(ArrayIndex, 2 + (ArrayCtr - 1) * 5 + 1) = AA.ResourceName
        arrResSpread(ArrayIndex, 2 + (ArrayCtr - 1) * 5 + 2) = AA.Work / 60
        arrResSpread(ArrayIndex, 2 + (ArrayCtr - 1) * 5 + 3) = AA.RemainingWork / 60
        arrResSpread(ArrayIndex, 2 + (ArrayCtr - 1) * 5 + 4) = AA.Cost
        arrResSpread(ArrayIndex, 2 + (ArrayCtr - 1) * 5 + 5) = AA.RemainingCost
            
        Dim i As Integer, s As String
        s = vbNullString
        For i = 1 To UBound(arrResSpread, 2)
            s = s & "-" & arrResSpread(ArrayIndex, i)
        Next i
        Debug.Print Mid$(s, 2)
                   
    Next AA
Next t

' presumably arrResSpread is written out to the Myfile at this point

End Sub