Quantcast
Channel: Project Customization and Programming forum
Viewing all articles
Browse latest Browse all 5347

Print Individual task Lists from Project 2010

$
0
0

Hi

I have a routine which prints individual task lists from a Project Plan using VBA.  This routine is currently being piloted and they have advised that not all resources have a task list produced.  when I step through the code the Resource numbers appears in this order:

1,3,18,7,8,9,11,12,13,14,18,19,20,21,22,23,24,25

Task lists are produced for each of the above resources.  However this misses resource numbers 2,4,5,6,10,15,16,17 and I have no idea why.  I have supplied my code below.  Any advice/guidance appreciated.  You will note that the task lists are exported to a pre-defined spreadsheet template.

Sub PrintResourceCharts()
Dim xlApp As Excel.Application
Dim xlRange As Excel.Range
Dim rName As String
Dim Tsk As Task
Dim Res As Resource
Dim Ass As Assignment
Dim s As Worksheet
Dim BookNam As String
Dim Row As Integer
Dim fName As String

'Call SetSummaryTask     - DB: commented out - run summaryname manually as required.
Call Task_CF_To_Assignment_CF

'Remove Existing Task List files from directory before creating new ones
On Error GoTo Finish
Kill "D:\Task List Templates\Task Lists\*.*"
Finish:

'Save File Location
fName = "D:\Task List Templates\Task Lists\"

'Start Excel and Create a new Workbook
Set xlApp = CreateObject("Excel.Application")
xlApp.Visible = True

'Export Resource and Task details
For Each Res In ActiveProject.Resources
    If Res.Assignments.Count > 0 Then
        Row = 5
        xlApp.Workbooks.Open ("D:\Task List Templates\Task List Template.xlsm")
        BookNam = xlApp.ActiveWorkbook.Name
        Set s = xlApp.Workbooks(BookNam).Worksheets(1)
        For Each Ass In Res.Assignments
            Set xlRange = s.Range("A5")
            If Ass.PercentWorkComplete < 100 Then
                With xlRange
                    rName = Ass.ResourceName
                    s.Range("A" & Row).Value = Ass.ResourceName
                    s.Range("B" & Row).Value = Ass.TaskUniqueID
                    s.Range("D" & Row).Value = Ass.Text1
                    s.Range("E" & Row).Value = Ass.Start
                    s.Range("G" & Row).Value = Ass.Finish
                End With
            End If
            Row = Row + 1
            Set xlRange = xlRange.Offset(Row, 0)  'Point to next row
        Next
        xlApp.Visible = True
        Application.DisplayAlerts = False
        If rName = "" Then
            GoTo Finished
        End If
        xlApp.ActiveWorkbook.SaveAs FileName:= _"D:\Task List Templates\Task Lists\" & rName & ".xlsm", FileFormat:= _
            xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
        rName = ""
        xlApp.ActiveWorkbook.Close savechanges:=False
        Application.DisplayAlerts = True
    End If
Next
Finished:
xlApp.Application.Quit
Set xlApp = Nothing
MsgBox ("Individual Task Lists have now been produced....")
End Sub


Viewing all articles
Browse latest Browse all 5347

Trending Articles



<script src="https://jsc.adskeeper.com/r/s/rssing.com.1596347.js" async> </script>