26. april 2012 19:18
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.
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
26. april 2012 20:08
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.
26. april 2012 20:29Redaktør
27. april 2012 00:22
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.
27. april 2012 01:17Redaktør
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 Project Management
- Markeret som svar af Mike GlenModerator 30. juni 2012 21:00