MS 项目到 Excel 甘特图使用 VBA

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

MS 项目到 Excel 甘特图使用 VBA

MS Project to Excel Gantt Chart using VBA

excel

vba

gantt-chart

ms-project