MS Project zu Excel Gantt-Diagramm mit VBA

Question

Ich versuche, einige Aufgaben von MS Project nach Excel mit einem VBA-Skript in Project zu exportieren. Bis jetzt bin ich in der Lage, die Daten, die ich will, ohne Problem zu exportieren, und es öffnet sich in Excel gut. Was ich jetzt versuche, ist, diese Daten in Excel zu übernehmen und in ein ähnliches Gantt-Diagramm wie in Project zu replizieren. Ich weiß, ich weiß, was ist der Sinn, all das durchzugehen, nur um ein Gantt-Diagramm in Excel zu bekommen, wenn ich bereits eines in Project habe? Unter anderem wird dieses Excel-Gantt-Diagramm erstellt, damit jeder ohne MS Project die geplanten Aufgaben ohne MS Project sehen kann.

Also was ich bisher versucht habe (da Excel keinen eingebauten Gantt-Maker hat) ist, das Diagramm auf der Tabelle zu machen, die Zellen zu färben, um ein Gantt-Diagramm nachzuahmen. Meine zwei Hauptprobleme: 1. Ich weiß nicht, wie man einen Offset für jede spezifische Aufgabe, abhängig davon, an welchem ​​Tag es beginnt, auf 2. Ich weiß nicht, wie man die richtige Anzahl von Zellen färbt (gerade jetzt Farben) Zellen in Vielfachen von 7 oder Wochen zu einer Zeit statt nach unten zu dem bestimmten Tag.

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

Wenn jemand ein besseren Vorschläge hat lass es mich wissen. ich bin ziemlich neu in diesem und nicht sicher, ob das überhaupt möglich ist oder ob es möglich ist und nur so kompliziert, dass es sich nicht einmal lohnt.

Answer 1

Es ist möglich, ich habe einen MACRO, der das seit Jahren macht. Verwenden Sie den folgenden Code.

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