none
Show only certain Tasks and Columns in a MPP file.. AND Help with VBA Export routine RRS feed

  • Question

  • Hello:

    I need to be able to provide several project schedules on a weekly basis. I only show tasks that are displayed on the screen in the current view. For example, I might want to collapse some tasks and only show the roll up..

    I have found the following code that will take what is on the screen in my current MPP file and export it to XLS. This is a great start, however I want to have this in an MPP file, not an XLS.

    So I have two questions:

    1. Can I save a current MPP file and only include the tasks AND columns that are currently displayed on the screen. So if someone opens it, they CAN'T view hidden columns, or tasks.

    2. If not, can someone PLEASE, PLEASE help me modify this VBA code so it will 'export' this information into another MPP file instead of XLS?

    I really appreciate any help and support that can be provided.

    Thanks

    Option Explicit
    
    'store information about what is on each row
    Type RowType
        TaskType As String
        OutlineNumber As String
        OutlineLevel As Integer
    End Type
      
    Sub Export2ExcelComp()
        Dim Rows As Integer, Columns As Integer, Item() As String
        Dim RowTypes() As RowType
        Dim Row As Integer, Column As Integer, Count As Integer
        Dim NameColumn As Integer, Color As Long, Indent As Integer
        Dim StartColumn As Integer, FinishColumn As Integer, CompColumn As Integer
        Dim Text As String, TaskType As String, ProjectName As String
        Dim Filename As Variant, Task As Task
        Dim NameColumnTitle As String, FinishColumnTitle As String, CompColumnTitle As String
        Dim objExcel As Object, objBook As Object
        
        On Error GoTo Error_Handler
        
        '==========================
        'Project part of macro
        '==========================
        'get project name from title
        ProjectName = ActiveProject.ProjectSummaryTask.Name
        'get name column title
        SelectTaskColumn Column:="Name"
        NameColumnTitle = ActiveCell.FieldName
        SelectTaskColumn Column:="Finish"
        FinishColumnTitle = ActiveCell.FieldName
        SelectTaskColumn Column:="% Complete"
        CompColumnTitle = ActiveCell.FieldName
        'select entire area
        SelectSheet
        'perform extraction
        Rows = ActiveSelection.Tasks.Count + 1
        Columns = ActiveSelection.FieldIDList.Count
        ReDim Item(Rows, Columns)
        ReDim RowTypes(Rows)
        'grab the header row (not available in selection)
        Row = 1
        For Column = 1 To Columns
            Text = Application.CustomFieldGetName(ActiveSelection.FieldIDList(Column))
            If Text = "" Then Text = ActiveSelection.FieldNameList(Column)
            Item(Row, Column) = Text
        Next
        'grab the row description
        For Each Task In ActiveSelection.Tasks
            Row = Row + 1
            TaskType = "N"
            If Not (Task Is Nothing) Then 'used to detect blank lines
                If Task.Summary Then TaskType = "S"
                If Task.Milestone Then TaskType = "M"
                RowTypes(Row).TaskType = TaskType
                RowTypes(Row).OutlineLevel = Task.OutlineLevel
                RowTypes(Row).OutlineNumber = Task.OutlineNumber
                ' grab the selection details
                For Column = 1 To Columns
                    Item(Row, Column) = Task.GetField(ActiveSelection.FieldIDList(Column))
                Next
            End If
        Next
        '==========================
        'Excel part of macro
        '==========================
        'set up a new worksheet
        Set objExcel = CreateObject("Excel.Application")
        With objExcel
            .Application.Visible = True
            .Workbooks.Add
        End With
        Set objBook = objExcel.ActiveWorkbook
        'write the column headers
        Row = 1
        For Column = 1 To Columns
            'set the column header format
            objExcel.cells(Row, Column) = Item(Row, Column)
            objExcel.cells(Row, Column).Font.Bold = True
            objExcel.cells(Row, Column).Font.Underline = False
            objExcel.cells(Row, Column).Font.Color = RGB(255, 255, 255)
            objExcel.cells(Row, Column).Interior.Color = RGB(0, 0, 255)
            'get column numbers and size task name field
            If Item(Row, Column) = NameColumnTitle Then
                NameColumn = Column
                objExcel.Columns(Column).columnwidth = 50
            ElseIf Item(Row, Column) = FinishColumnTitle Then
                 FinishColumn = Column
            ElseIf Item(Row, Column) = CompColumnTitle Then
                 CompColumn = Column
            End If
        Next
        'write the selection details
        For Row = 2 To Rows
            TaskType = RowTypes(Row).TaskType
            'format the row according to task type
            objExcel.Rows(Row).Font.Bold = (TaskType = "S")
            Color = RGB(0, 0, 0)
            If TaskType = "S" Then Color = RGB(0, 0, 0)
            If TaskType = "M" Then Color = RGB(0, 0, 0)
            objExcel.Rows(Row).Font.Color = Color
            'align vertical to top
            objExcel.Rows(Row).VerticalAlignment = -4160
            objExcel.Rows(Row).WrapText = True
            For Column = 1 To Columns
            'if this is the name column, we need to indent it and add the outline number
                If Column = NameColumn Then
                    Text = ""
                    For Count = 1 To RowTypes(Row).OutlineLevel
                        Indent = Indent + 1
                    Next
                    objExcel.cells(Row, Column) = Text + Item(Row, Column)
                    objExcel.cells(Row, Column).IndentLevel = Indent
                ElseIf Column = FinishColumn Then
                    objExcel.cells(Row, Column).FormatConditions.Delete
                    objExcel.cells(Row, Column).FormatConditions.Add Type:=2, Formula1:= _
                        "=IF(R" & Row & "C" & CompColumn & "=0,IF(R" & Row & "C" & Column & "<NOW(),1,0),0)"
                    objExcel.cells(Row, Column).FormatConditions(1).Font.ColorIndex = 2
                    objExcel.cells(Row, Column).FormatConditions(1).Interior.ColorIndex = 3
                    objExcel.cells(Row, Column).FormatConditions.Add Type:=2, Formula1:= _
                        "=IF(R" & Row & "C" & CompColumn & "=0,IF(R" & Row & "C" & Column & "<NOW()+2,1,0),0)"
                    objExcel.cells(Row, Column).FormatConditions(2).Interior.ColorIndex = 6
                    objExcel.cells(Row, Column) = Item(Row, Column)
                Else
                    objExcel.cells(Row, Column) = Item(Row, Column)
                End If
            Next
            Indent = 0
        Next
        'make the columns fit - within some limits
        objExcel.Columns.AutoFit
        For Column = 1 To Columns
            Count = objExcel.Columns(Column).columnwidth
            Text = Item(1, Column)
            If Column <> NameColumn And Count > 12 Then
                objExcel.Columns(Column).columnwidth = 16
            End If
            If Column = NameColumn Then
                objExcel.Columns(Column).columnwidth = 80
            End If
        Next
        'delete the indicators column
        For Column = 1 To Columns
            Text = Item(1, Column)
            If Text = "Indicators" Then
                objExcel.Columns(Column).Delete
                Exit For
            End If
        Next
        'turn on autofilter
        objExcel.Worksheets(1).Range("A1").AutoFilter
        'objExcel.Worksheets(1).Range("A1").AutoFilter Field:=7, Criteria1:="<100%", Operator:=1
        'set up page
        With objExcel.Worksheets(1).PageSetup
            .PrintTitleRows = "$1:$1"
            .CenterHeader = ProjectName
            .leftfooter = "&D &T"
            .CenterFooter = ""
            .rightfooter = "&P of &N"
            'set orientation to landscape
            .Orientation = 2
            .Zoom = False
            .FitToPagesWide = 1
            .FitToPagesTall = 50
            .PrintGridlines = True
        End With
        'bring up the dialog to ask for a filename
        Filename = objExcel.Application.GetSaveAsFilename( _
            FileFilter:="Excel Spreadsheets (*.xls), *.xls", _
            InitialFilename:="ProjectExtract.xls", _
            Title:="Save Project Extract to Excel as")
        'save the file as a shared work with tracking
        objExcel.ActiveWorkbook.KeepChangeHistory = True
        If Filename <> False Then objBook.SaveAs Filename:=Filename
        Set objExcel = Nothing
        Set objBook = Nothing
    Exit Sub
        
    Error_Handler:
        MsgBox Error
        Set objExcel = Nothing
        Set objBook = Nothing
    End Sub

    Thursday, April 26, 2012 7:18 PM

Answers

  • Not without a lot of work. For example to create summary tasks etc. etc. It can be done, but the devil is always in teh detail for this type of macro. I suggest you stay with teh Excel version because they can copy and paste back to Project if wanted, but obviously there would be no links to missing tasks.

    Therein lies your biggest problem. If the tasks to export don't include critical tasks and other tasks driving dates of key tasks, then you need to fix all tasks with date constraints, so no critical path, no flexibility, so why would they use it?


    Rod Gill

    The one and only Project VBA Book

    Rod Gill Project Management

    Friday, April 27, 2012 1:17 AM
    Moderator

All replies

  • kpierce63,

    The answer to your first question is no. There is no way to "lock out" certain data in a project file unless the file is password protected. It's either all or none.

    For your second question, the answer isn't quite as simple as one might think. If you have collapsed or filtered the project file, you won't be able to simply copy those into a new project file without changing the file structure. Some of the data may translate into a manually scheduled Project 2010, but most of the data will still require a lot of manual manipulation to represent what you intend.

    If you are primarily interested in creating summarized data of Project schedules on a periodic basis, I think you best choice is either use hard copy or export of the desired data to Excel using VBA.

    John

    Thursday, April 26, 2012 8:08 PM
  • Or send a pdf file of what's in the project.

    Rod Gill

    The one and only Project VBA Book Rod Gill Project Management

    Thursday, April 26, 2012 8:29 PM
    Moderator
  • Yes, we are already sending the data via a PDF but the user wants a copy they can 'cut and paste from'.

    Can you export what is on the screen(only visible tasks) to another MS project file?

    Just like the code that is attached, but instead of going to Excel it goes to MS Project.

    thanks

    Friday, April 27, 2012 12:22 AM
  • Not without a lot of work. For example to create summary tasks etc. etc. It can be done, but the devil is always in teh detail for this type of macro. I suggest you stay with teh Excel version because they can copy and paste back to Project if wanted, but obviously there would be no links to missing tasks.

    Therein lies your biggest problem. If the tasks to export don't include critical tasks and other tasks driving dates of key tasks, then you need to fix all tasks with date constraints, so no critical path, no flexibility, so why would they use it?


    Rod Gill

    The one and only Project VBA Book

    Rod Gill Project Management

    Friday, April 27, 2012 1:17 AM
    Moderator