View Single Post
 
Old 10-29-2021, 07:07 AM
Rsquest Rsquest is offline Windows 10 Office 2019
Novice
 
Join Date: Sep 2021
Posts: 9
Rsquest is on a distinguished road
Default

I was actually able to find this VBA code that I used to create a macro in MS Project which pushes the mpp data into an Excel spreadsheet and indents the tasks. I am going to use this to grow the export so that I can create multiple worksheets with different views that I can send out to different stakeholder groups who do not have Project licenses.
Option Explicit
Dim xlRow As Excel.Range
Dim xlCol As Excel.Range
Sub TaskHierarchy()
Dim xlApp As Excel.Application
Dim xlBook As Excel.Workbook
Dim xlSheet As Excel.Worksheet
Dim Proj As Project
Dim t As Task
Dim Asgn As Assignment
Dim ColumnCount As Integer
Dim Columns As Integer
Dim Tcount As Integer

Set xlApp = New Excel.Application
xlApp.Visible = True
AppActivate "Excel"

Set xlBook = xlApp.Workbooks.Add
Set xlSheet = xlBook.Worksheets.Add
xlSheet.Name = ActiveProject.Name

'count columns needed
ColumnCount = 0
For Each t In ActiveProject.Tasks
If Not t Is Nothing Then
If t.OutlineLevel > ColumnCount Then
ColumnCount = t.OutlineLevel
End If
End If
Next t

'Set Range to write to first cell
Set xlRow = xlApp.ActiveCell
xlRow = "Filename: " & ActiveProject.Name
dwn 1
xlRow = "OutlineLevel"
dwn 1

'label Columns
For Columns = 1 To (ColumnCount + 1)
Set xlCol = xlRow.Offset(0, Columns - 1)
xlCol = Columns - 1
Next Columns
rgt 2
xlCol = "Resource Name"
rgt 1
xlCol = "Start"
rgt 1
xlCol = "Finish"
rgt 1
xlCol = "work"
rgt 1
xlCol = "actual work"
Tcount = 0
For Each t In ActiveProject.Tasks
If Not t Is Nothing Then
dwn 1
Set xlCol = xlRow.Offset(0, t.OutlineLevel)
xlCol = t.Name
If t.Summary Then
xlCol.Font.Bold = True
End If
For Each Asgn In t.Assignments
dwn 1
Set xlCol = xlRow.Offset(0, Columns)
xlCol = Asgn.ResourceName
rgt 1
xlCol = (Asgn.Start)
rgt 1
xlCol = (Asgn.Finish)
rgt 1
xlCol = (Asgn.Work / 480) & " Days"
rgt 1
xlCol = (Asgn.ActualWork / 480) & " Days"
Next Asgn
Tcount = Tcount + 1
End If
Next t
AppActivate "Project"

MsgBox ("Macro Complete with " & Tcount & " Tasks Written")
End Sub
Sub dwn(i As Integer)
Set xlRow = xlRow.Offset(i, 0)
End Sub

Sub rgt(i As Integer)
Set xlCol = xlCol.Offset(0, i)
End Sub
Reply With Quote