Создать файл MS-проекта с основными задачами и вехами из Excel - PullRequest
Новая
       12

Создать файл MS-проекта с основными задачами и вехами из Excel

0 голосов
/ 05 марта 2019

Мне удалось сделать хороший скрипт, который может генерировать файл MS-проекта из выбранных таблиц в Excel.Сейчас я ищу помощь, чтобы сделать ее немного более полезной.Я хотел бы вставить вехи в каждой основной задаче из конкретной таблицы в Excel.Каждое основное задание имеет соответствующую таблицу этапов. 

Sub MSPexport()

Dim pjapp As Object
Dim strValue, strWorktime, strMilestone As String
Dim newproj
Set pjapp = CreateObject("MSProject.application") 

If pjapp Is Nothing Then
MsgBox "Project is not installed"
End
End If

pjapp.Visible = True
Set newproj = pjapp.Projects.Add
Set ActiveProject = newproj

pjapp.NewTasksStartOn

'insert tasks here

 For I = 3 To 8 'currently I am pointing to the range A3:A:8 - would like to make it a named range instead - ie "Maintasks" - how to do this?

    strValue = Worksheets("Planning").Range("A" & I)
    newproj.Tasks.Add (strValue)

    'Insert predecessor if not first task
    If I <> 3 Then
      newproj.Tasks(I - 2).Predecessors = (I - 3)
    End If

    'here I would like to insert milestones as subtasks

    For M = 3 to 5 ' this I also would like to be a named range and also I need to check for or lookup the correct main task and the corresponding milestone list
      strMilestone = Worksheets("Milestones").Range("C" & M)
        newproj.Tasks.Add (strMilestone)
        newproj.Tasks(M - 2).Duration = 0
        newproj.Tasks(M - 2).OutlineIndent
        newproj.Tasks(M - 2).Predecessors = (I - 26)
    Next M   
Next I

End Sub

MS-Project должен выглядеть следующим образом: The MS-Project should look like this when done

Excel tables

1 Ответ

0 голосов
/ 06 марта 2019

Вот код, обновленный до 1) использования именованных диапазонов и 2) вставки этапов: 

Sub MSPexport()

Dim pjapp As Object
Dim newproj As Object

Set pjapp = CreateObject("MSProject.application")
If pjapp Is Nothing Then
    MsgBox "Project is not installed"
    Exit Sub
End If
pjapp.Visible = True
Set newproj = pjapp.Projects.Add
pjapp.NewTasksStartOn

Dim rngMain As Range
Set rngMain = ActiveWorkbook.Names("Maintasks").RefersToRange
Dim MainTask As Range
Dim tskPredTaskMain As Object

For Each MainTask In rngMain.Cells
    Dim tskSummary As Object
    Set tskSummary = newproj.Tasks.Add(MainTask.Value)
    tskSummary.OutlineLevel = 1

    Dim rngMS As Range
    Set rngMS = ActiveWorkbook.Names(MainTask.Value & "_Milestones").RefersToRange
    Dim Milestone As Range
    Dim tskPredTaskMS As Object
    Set tskPredTaskMS = Nothing

    For Each Milestone In rngMS
        Dim tskMS As Object
        Set tskMS = newproj.Tasks.Add(Milestone.Value)
        ' use duration stored in days in column to the right
        tskMS.Duration = Milestone.Offset(, 1).Value * 8 * 60
        tskMS.OutlineLevel = 2

        If Not tskPredTaskMS Is Nothing Then
            tskMS.Predecessors = tskPredTaskMS.ID
        End If
        Set tskPredTaskMS = tskMS

    Next Milestone

    If Not tskPredTaskMain Is Nothing Then
        tskSummary.Predecessors = tskPredTaskMain.ID
    End If
    Set tskPredTaskMain = tskSummary

Next MainTask

End Sub
...