MS Project to Excel Диаграмма Ганта с использованием VBA

Question

Я пытаюсь экспортировать некоторые задания из MS Project в Excel с помощью скрипта VBA в Project. Пока я могу экспортировать данные, которые я хочу без проблем, и он отлично открывается в Excel. То, что я пытаюсь сделать сейчас, это взять эти данные в Excel и скопировать в диаграмму Ганта, аналогичную диаграмме в проекте. Я знаю, что знаю, для чего все это нужно, чтобы получить диаграмму Ганта в Excel, когда у меня уже есть один в проекте? Ну, помимо всего прочего, эта диаграмма gantt Excel создается так, что каждый без MS Project может просматривать запланированные задачи без MS Project.

Итак, что я пробовал до сих пор (поскольку у excel нет встроенного в Gantt maker), это сделать диаграмму в электронной таблице, окрашивая ячейки, чтобы имитировать диаграмму Ганта. Мои две основные проблемы: 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