Results 1 to 2 of 2

Thread: Show only certain Tasks and Columns in a MPP file.. AND Help with VBA Export routine

  1. #1
    Join Date
    Apr 2012
    Posts
    1

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

    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.
    I am using MS Project 2007

    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

    Code:
    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

  2. #2
    Join Date
    Dec 2006
    Posts
    489

    Re: Show only certain Tasks and Columns in a MPP file.. AND Help with VBA Export routine

    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.
    No, sorry. If you give someone an .mpp file, they can simply unfilter and unhide any 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.
    Sorry, I'm not a VBA person. But, let me ask this question -- have you tried a straight forward copy/paste of the selected tasks into a new project file? Have you tried importing the resulting excel file (from your code) into Project?

    You might try posting your question to the Microsoft Forum devoted to programming -- you may catch someone's eye there. See:

    If you post there, please state explicitly what version of Project including service pack.

    Julie

Similar Threads

  1. Routine backup occur regardless of File/Directory
    By Deandre in forum Software Development
    Replies: 4
    Last Post: 17-06-2010, 04:42 AM
  2. How to Export file and folder names to text file in MAC?
    By Colten in forum Operating Systems
    Replies: 6
    Last Post: 31-05-2010, 09:39 AM
  3. Replies: 1
    Last Post: 26-11-2009, 02:00 AM
  4. Determine number of columns in a file
    By Chrisch in forum Software Development
    Replies: 3
    Last Post: 12-05-2009, 11:19 PM
  5. Easy way to export Project tasks to Outlook?
    By biggcb in forum Windows Software
    Replies: 1
    Last Post: 17-04-2009, 09:56 PM

Tags for this Thread

Bookmarks

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •  
Page generated in 1,711,704,199.97389 seconds with 17 queries