INTELLIGENT WORK FORUMS
FOR ENGINEERING PROFESSIONALS
Come Join Us!
Are you an
Engineering professional?
Join Eng-Tips now!
- Talk With Other Members
- Be Notified Of Responses
To Your Posts
- Keyword Search
- One-Click Access To Your
Favorite Forums
- Automated Signatures
On Your Posts
- Best Of All, It's Free!
*Eng-Tips's functionality depends on members receiving e-mail. By joining you are opting in to receive e-mail.
Partner With Us!
"Best Of Breed" Forums Add Stickiness To Your Site
(Download This Button Today!)
Feedback
"...Over the past year I have found your site to be EXCELLENT. Never have I been able to find so many answers to such vast problems and it is an excellent service..."
Geography
Where in the world do Eng-Tips members come from?
|
Show only certain Tasks and Columns in a MPP file.. AND Help with VBA
|
|
|
kpierce (Industrial) |
26 Apr 12 15:33 |
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
|
|
Actually I did not look at your code at all. I wonder what you are really up to. I get the feeling that you want others only to have a look at your view and nothing more. Hiding would, as far as I know, not help a bit as everyone would be able to add columns again. I would make a separate view with all the columns you want to show and a few others as well. This would include Overview Level, Constraint Type and Constraint date, Deadline Date [if used by you, something I would highly recommend], perhaps Task calendars etc. If you use anything special, e.g. Filters, Groups, Custom fields [as far needed in the new file],Views with specific Bar Styles, make sure that you copy these with the Organizer to a new Project File. Set also the correct Start Date for the Project. Also arrange all columns in the new file exactly as in the special view in your original. [This can easily done with the Organizer as well, just by copying the table] Then select the columns [NOT the whole view] in the original file, copy and paste to the new one. Hide some additional columns [such as Overview Level] and save the new file. Now only additional Custom Fields can not be retrieved by someone using the new file [and perhaps also no baselines if not copied] Remember that if you filter certain rows away, containing links, that the new schedule may contain new constraints as you have Start dates included. This looks perhaps rather complicated. However, if it would always refer to the same project, just make a template in which to paste. You could make a macro for that. However, in my view preparing the template and the simple copy paste may be much faster. If you only would like to show the information to others, why not just print as a pdf-file from your special view? Once more, realize that all fields in a given file can be made visible, no matter what you want to hide. If you only want to hide certain rows then still a full copy paste would not help you. Success. Why an easy solution if you can make it complicated?
Greetings from the Netherlands |
|
Was my advise of any help? Why an easy solution if you can make it complicated?
Greetings from the Netherlands |
|
|
 |
|
Talk To Other Members
Read More Threads Like This One