生成包含来自 excel 的主要任务和里程碑的 MS 项目文件

Question

我设法制作了一个不错的脚本，可以从 excel 中选定的 table 生成一个 MS 项目文件。我现在正在寻求帮助以使其更有用。我想在 excel 中特定 table 的每个主要任务下插入里程碑。每个主要任务都有相应的 table 个里程碑。

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 项目完成后应该如下所示：

Answer 1

这是更新为 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

生成包含来自 excel 的主要任务和里程碑的 MS 项目文件

Generate MS-project file with main tasks and milestones from excel

excel

vba

ms-project