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

Я пытаюсь экспортировать некоторые задачи из MS Project в Excel с помощью сценария VBA в Project. Пока я могу без проблем экспортировать нужные мне данные, и они прекрасно открываются в Excel. Сейчас я пытаюсь взять эти данные в Excel и воспроизвести их в диаграмму Ганта, аналогичную той, что есть в Project. Я знаю, я знаю, какой смысл проходить через все это только для того, чтобы получить диаграмму Ганта в Excel, когда она у меня уже есть в Project, верно? Ну, среди прочего, эта диаграмма Ганта в 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

Скриншот текущего вывода проекта MS в Excel

Если у кого-то есть лучшие предложения, дайте мне знать. Я новичок в этом и не уверен, возможно ли это вообще или возможно, и настолько сложно, что оно того не стоит.


excel vba gantt-chart ms-project
person mithirich    schedule 25.05.2016    source источник

Ответы (1)


arrow_upward
0
arrow_downward

Возможно, у меня есть МАКРОС, который делает это годами. Используйте приведенный ниже фрагмент кода.

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
person Shai Rado    schedule 26.05.2016
comment
Вау, невероятно!!! Это работает намного лучше, чем то, что я пытался сделать, просто нужно настроить несколько вещей, но пока это выглядит хорошо! Большое спасибо. - person mithirich; 27.05.2016
comment
Привет, я новичок в Project Macros, поэтому я подумал, что начну с вашего кода, но при его запуске в Project 2013 я получаю ошибку Complie: определяемый пользователем тип не определен в команде Dim xlApp As Excel.Application. Чтение (stackoverflow.com/questions/19680402/), похоже, произошли изменения в формате кода. Это правильно, или мне нужно искать другое место в моем собственном проекте, как я думал, что код обратно совместим? Заранее спасибо T - person Terran Brown; 01.12.2016
comment
@TerranBrown, не могли бы вы открыть новый пост со своим вопросом, отметьте мое имя знаком @, чтобы я его посмотрел - person Shai Rado; 01.12.2016
comment
Привет, Шай! Я пытался пометить тебя через @, но по какой-то причине не удалось ... Я открыл новый вопрос по адресу stackoverflow.com/questions/40913058/ - заранее спасибо за вашу помощь - person Terran Brown; 01.12.2016