MS项目到Excel甘特图使用VBA
我正在尝试使用Project中的VBA脚本将某些任务从MS Project导出到Excel。 到目前为止，我能够导出我想要的数据没有问题，它在Excel中打开就好了。 我现在要做的是在Excel中取出这些数据并复制到类似于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(ie 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 Excel中当前MS项目输出的屏幕截图
如果有人有更好的build议，请让我知道。 我很新，不知道这是甚至可能的，或者如果可能，只是如此复杂，甚至不值得。
有可能，我有一个多年的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