O site http://masamiki.com/project/ é especializado em materiais e programação, inclusive VBA, focada no Microsoft Project.
Uma das macros que me interessou por uma necessidade recente foi a de exportar as tarefas de um cronograma do Project para o Excel, mantendo sua hierarquia. De pronto, o site tinha uma macro que fazia exatamente isso:
http://masamiki.com/project/export-hierarchy-to-excel.html
A macro só contém um pequeno erro, que pode algumas vezes ocasionar uma falha. A linha que atribui o nome à planilha (worksheet) do Excel não considera o limite de 31 caracteres para seu nome:
xlSheet.Name = ActiveProject.Name |
Caso o nome do arquivo mpp exceder o limite, a falha ocorrerá. Uma solução simples é ignorar a linha, comentado-a, ou truncar no nome do projeto, conforme a linha abaixo:
xlSheet.Name = Left(ActiveProject.Name, 31) |
Abaixo segue o código completo:
'This module contains macros which will export 'tasks to excel and keep the task hierarchy. 'modify as necessary to include other task information 'Copyright Jack Dahlgren, Feb 2002 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 "Microsoft Excel" Set xlBook = xlApp.Workbooks.Add Set xlSheet = xlBook.Worksheets.Add xlSheet.Name = Left(ActiveProject.Name, 31) '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 = "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.Work / 480) & " Days" rgt 1 xlCol = (Asgn.ActualWork / 480) & " Days" Next Asgn Tcount = Tcount + 1 End If Next t AppActivate "Microsoft 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 |
Lembrando que essa macro deve ser utilizada no Microsoft Project, e é preciso adicionar a referência à biblioteca do Microsoft Excel no VBA.
Bom proveito!