使用 VBA 将 MS Project 转换为 Excel 甘特图

Question

我正在尝试使用 Project 中的 VBA 脚本将一些任务从 MS Project 导出到 Excel。到目前为止，我能够毫无问题地导出我想要的数据，并且它在 Excel 中打开得很好。我现在要做的是将 Excel 中的数据复制到类似于 Project 中的甘特图。我知道我知道，当我在 Project 中已经有了甘特图时，为了在 Excel 中获得甘特图而经历这一切有什么意义？除其他事项外，正在制作此 Excel 甘特图，以便没有 MS Project 的每个人都可以在没有 MS Project 的情况下查看计划任务。

所以到目前为止我所尝试的（因为 excel 没有内置甘特图制作工具）是在电子表格上制作图表，为单元格着色以模仿甘特图。我的两个主要问题： 1. 我不知道如何为每个特定任务添加偏移量，具体取决于它从哪一天开始 2. 我不知道如何为正确数量的单元格着色（现在它以 7 的倍数或一周一次而不是到特定日期着色单元格。

Sub ExportToExcel()
Dim xlApp As Excel.Application
Dim xlBook As Excel.Workbook
Dim xlSheet As Excel.Worksheet
Dim proj As Project
Dim t As Task
Dim pj As Project
Dim i As Integer
Set pj = ActiveProject
Set xlApp = New Excel.Application
xlApp.Visible = True
AppActivate "Excel"
Set xlBook = xlApp.Workbooks.Add
Set xlSheet = xlBook.Worksheets(1)
xlSheet.Cells(1, 1).Value = "Project Name"
xlSheet.Cells(1, 2).Value = pj.Name
xlSheet.Cells(2, 1).Value = "Project Title"
xlSheet.Cells(2, 2).Value = pj.Title
xlSheet.Cells(4, 1).Value = "Task ID"
xlSheet.Cells(4, 2).Value = "Task Name"
xlSheet.Cells(4, 3).Value = "Task Start"
xlSheet.Cells(4, 4).Value = "Task Finish"

For Each t In pj.Tasks
    xlSheet.Cells(t.ID + 4, 1).Value = t.ID
    xlSheet.Cells(t.ID + 4, 2).Value = t.Name
    xlSheet.Cells(t.ID + 4, 3).Value = t.Start
    xlSheet.Cells(t.ID + 4, 4).Value = t.Finish

    Dim x As Integer
    'x is the duration of task in days(i.e. half a day long task is 0.5)
    x = t.Finish - t.Start
    'Loop to add day of week headers and color cells to mimic Gantt chart
    For i = 0 To x
        xlSheet.Cells(4, (7 * i) + 5).Value = "S"
        xlSheet.Cells(4, (7 * i) + 6).Value = "M"
        xlSheet.Cells(4, (7 * i) + 7).Value = "T"
        xlSheet.Cells(4, (7 * i) + 8).Value = "W"
        xlSheet.Cells(4, (7 * i) + 9).Value = "T"
        xlSheet.Cells(4, (7 * i) + 10).Value = "F"
        xlSheet.Cells(4, (7 * i) + 11).Value = "S"

        xlSheet.Cells(t.ID + 4, ((7 * i) + 5)).Interior.ColorIndex = 37
        xlSheet.Cells(t.ID + 4, (7 * i) + 6).Interior.ColorIndex = 37
        xlSheet.Cells(t.ID + 4, (7 * i) + 7).Interior.ColorIndex = 37
        xlSheet.Cells(t.ID + 4, (7 * i) + 8).Interior.ColorIndex = 37
        xlSheet.Cells(t.ID + 4, (7 * i) + 9).Interior.ColorIndex = 37
        xlSheet.Cells(t.ID + 4, (7 * i) + 10).Interior.ColorIndex = 37
        xlSheet.Cells(t.ID + 4, (7 * i) + 11).Interior.ColorIndex = 37
    Next i
Next t
End Sub

Screenshot of current MS project output in Excel

如果有人有更好的建议，请告诉我。我对此很陌生，不确定这是否可能，或者它是否可能并且太复杂以至于它甚至不值得。

Answer 1

有可能，我有一个 MACRO 可以这样做多年。 使用下面的代码。

Sub ExportToExcel()

Dim xlApp As Excel.Application
Dim xlBook As Excel.Workbook
Dim xlSheet As Excel.Worksheet
Dim proj As Project
Dim t As Task
Dim pj As Project
Dim pjDuration As Integer
Dim i As Integer
Set pj = ActiveProject
Set xlApp = New Excel.Application
xlApp.Visible = True
'AppActivate "Excel"
Set xlBook = xlApp.Workbooks.Add
Set xlSheet = xlBook.Worksheets(1)
xlSheet.cells(1, 1).Value = "Project Name"
xlSheet.cells(1, 2).Value = pj.Name
xlSheet.cells(2, 1).Value = "Project Title"
xlSheet.cells(2, 2).Value = pj.Title
xlSheet.cells(1, 4).Value = "Project Start"
xlSheet.cells(1, 5).Value = pj.ProjectStart
xlSheet.cells(2, 4).Value = "Project Finish"
xlSheet.cells(2, 5).Value = pj.ProjectFinish

xlSheet.cells(1, 7).Value = "Project Duration"
pjDuration = pj.ProjectFinish - pj.ProjectStart
xlSheet.cells(1, 8).Value = pjDuration & "d"

xlSheet.cells(4, 1).Value = "Task ID"
xlSheet.cells(4, 2).Value = "Task Name"
xlSheet.cells(4, 3).Value = "Task Start"
xlSheet.cells(4, 4).Value = "Task Finish"

' Add day of the week headers for the entire Project's duration
For i = 0 To pjDuration
    xlSheet.cells(4, i + 5).Value = pj.ProjectStart + i
    xlSheet.cells(4, i + 5).NumberFormat = "[$-409]d-mmm-yy;@"
Next

For Each t In pj.Tasks
    xlSheet.cells(t.ID + 4, 1).Value = t.ID
    xlSheet.cells(t.ID + 4, 2).Value = t.Name
    xlSheet.cells(t.ID + 4, 3).Value = t.Start
    xlSheet.cells(t.ID + 4, 3).NumberFormat = "[$-409]d-mmm-yy;@"
    xlSheet.cells(t.ID + 4, 4).Value = t.Finish
    xlSheet.cells(t.ID + 4, 4).NumberFormat = "[$-409]d-mmm-yy;@"

    For i = 5 To pjDuration + 5
        'Loop to add day of week headers and color cells to mimic Gantt chart
        If t.Start <= xlSheet.cells(4, i) And t.Finish >= xlSheet.cells(4, i) Then
            xlSheet.cells(t.ID + 4, i).Interior.ColorIndex = 37
        End If
     Next i
Next t