MS项目到Excel甘特图使用VBA [英] MS Project to Excel Gantt Chart using VBA

问题描述

我正在尝试使用Project中的VBA脚本将一些任务从MS Project导出到Excel。到目前为止，我可以导出我想要的数据没有问题，它在Excel中打开就行了。我现在要做的是将数据放在Excel中，并复制到类似于Project中的甘特图。我知道我知道，当我已经有一个在项目权利的时候，通过这些只是为了在Excel中获得甘特图？除此之外，这个Excel甘特图正在进行，所以没有MS Project的所有人都可以在没有MS Project的情况下查看计划的任务。

I'm trying to export some tasks from MS Project to Excel using a VBA script in Project. So far I am able to export the data I want with no issue and it opens in Excel just fine. What I'm trying to do now is take that data in Excel and replicate into a Gantt chart similar to the one in Project. I know I know, what's the point of going through all this just to get a Gantt chart in Excel when I already have one in Project right? Well among other things this Excel gantt chart is being made so that everyone without MS Project can view the scheduled tasks without having MS Project.

所以我到目前为止已经尝试过（因为excel没有内置的甘特制造商）是在电子表格上制作图表，使单元格模拟甘特图。我的两个主要问题：
1.我不知道如何为每个特定任务添加一个偏移量，取决于它在
上开始的那一天。2.我不知道如何将正确的数量单元格（现在它以7的倍数，或一个星期的时间，而不是一天的颜色细胞。

So what I've tried so far(since excel doesn't have a built in Gantt maker) is to make the chart on the spreadsheet, coloring the cells to mimic a Gantt chart. My two main issues: 1. I don't know how to add an offset for each specific task depending on what day it starts on 2. I don't know how to color the correct number of cells(right now it colors cells in multiples of 7, or weeks at a time instead of down to the specific day.

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

Excel中当前MS项目输出的屏幕截图

如果有任何更好的建议，请让我知道。我很新，不知道这是否可能，或者是否可能，如此复杂，甚至不值得。

If anyone has any better suggestions please let me know. I'm pretty new to this and not sure if this is even possible or if it is possible and just so complicated that its not even worth it.

推荐答案

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

It is possible, I have a MACRO that does that for years. Use the piece of code below.

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的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！