Microsoft Project Code Example #2

This example, which runs with Microsoft Project as a VBA macro will:


1		Use the active Microsoft Project schedule.
2		Generate a Milestones Professional schedule with DataGraph, like the one shown below.

TRY THIS EXAMPLE

VISUAL BASIC CODE (Milestones interface calls shown in Blue)

Public Sub ProjectExample2()
Dim objMilestones As Object
Dim currentrow As Integer

Dim Tsk As Task

Dim currentpage As Integer
Dim LinesPerPage As Integer
Dim NewPage As Integer
Dim symbolcount As Integer

'First, check to see if there are any tasks in the current MS Project file
'If not, put up a message box and quit
numberofprojecttasks = MSProject.ActiveProject.Tasks.Count
If numberofprojecttasks < 1 Then
MsgBox ("No Tasks in the MS Project Schedule")
GoTo ExitLabel
End If

' Create Milestones Professional Object
Set objMilestones = CreateObject("Milestones")

NewPage = 1
currentpage = 1

With objMilestones
.Activate
.KeepScheduleOpen
.Template "ProjectTemplate2.mtp"

label1:

'Set all symbols on the Milestones Professional schedule to a size of 0.5
.SetGlobalSymbolSize 0.5

label2:
'Find out (from Project), how many tasks are in the active project
numberofrows = MSProject.ActiveProject.Tasks.Count

'Set the # of lines per page on the Milestones Professional schedule to 40
.SetLinesPerPage 40
LinesPerPage = 40

'Set the default column text font size to 9 point
.SetFontSize 1, 9

'Set the default symbol text font size to 9 point
.SetFontSize 2, 9

'Set the schedule's Title
.SetTitle1 ActiveProject.Title
.SetTitle2 "Author: " & ActiveProject.Author
.SetTitle3 "Start Date: " & ActiveProject.ProjectStart

'Refresh the screen
.refresh

putouttasks:

currentrow = 0

For Each Tsk In MSProject.ActiveProject.Tasks

'currentrow keeps track of the row # on the Milestones Professional schedule
currentrow = currentrow + 1

On Error GoTo addblankrow

'Add the task name to column 1 of the current row
.PutCell currentrow, 1, Tsk.Name

'Add the Cost value to to column 6. This column is used for the ValueSet/DataGraph
.PutCell currentrow, 6, Tsk.Cost

'Set the outline level for the current task
.SetOutlineLevel currentrow, Tsk.OutlineLevel

'Use different symbology for the summary tasks

If Tsk.OutlineLevel = 1 Then

		.AddSymbol currentrow, Format(Tsk.Start, "mm/dd/yy"), 1, 1, 2, 0, 0, 1, 0, 0,Tsk.Name
		.AddSymbol currentrow, Format(Tsk.Finish, "mm/dd/yy"), 1, 1, 0, 1, Val(Tsk.Successors), 1, 0, 0

End If

		.AddSymbol currentrow, Format(Tsk.Start, "mm/dd/yy"), 1, 1, 2, 0, 0, 1, 0, 0, Tsk.Name
		.AddSymbol currentrow, Format(Tsk.Finish, "mm/dd/yy"), 1, 1, 0, 1, Val(Tsk.Successors), 1, 0, 0

'Display non-summary bars

symbolcount = 0
If Tsk.OutlineLevel > 1 Then

If Tsk.SplitParts.Count > 1 Then

For x = 1 To Tsk.SplitParts.Count - 1

symbolcount = symbolcount + 1

.AddSymbol currentrow, Format(Tsk.SplitParts.Item(x).Start, "mm/dd/yy"), 2, 2, symbolcount + 1, 0, 0, 0, Int(Format(Tsk.SplitParts.Item(x).Start, "h")), Int(Format(Tsk.SplitParts.Item(x).Start, "n")), Tsk.Name

.SetSymbolProperty currentrow, 1, "SymbolNotes", Tsk.Notes

symbolcount = symbolcount + 1

.AddSymbol currentrow, Format(Tsk.SplitParts.Item(x).Finish, "mm/dd/yy"), 2, 2, 0, 0, 0, 0, Int(Format(Tsk.SplitParts.Item(x).Finish, "h")), Int(Format(Tsk.SplitParts.Item(x).Finish, "n")), Tsk.Name

Next x

symbolcount = symbolcount + 1

.AddSymbol currentrow, Format(Tsk.SplitParts.Item(x).Start, "mm/dd/yy"), 2, 2, symbolcount + 1, 0, 0, 0, Int(Format(Tsk.SplitParts.Item(x).Start, "h")), Int(Format(Tsk.SplitParts.Item(x).Start, "n")), Tsk.Name

symbolcount = symbolcount + 1

.AddSymbol currentrow, Format(Tsk.SplitParts.Item(x).Finish, "mm/dd/yy"), 2, 2, 1, 1, Val(Tsk.Successors), 1, Int(Format(Tsk.SplitParts.Item(x).Finish, "h")), Int(Format(Tsk.SplitParts.Item(x).Finish, "n")), Tsk.Name

Else

.AddSymbol currentrow, Format(Tsk.Start, "mm/dd/yy"), 2, 2, 2, 0, 0, 1, 0, 0, Tsk.Name

.SetSymbolProperty currentrow, 1, "SymbolNotes", Tsk.Notes

.AddSymbol currentrow, Format(Tsk.Finish, "mm/dd/yy"), 2, 1, 0, 1, Val(Tsk.Successors), 1

End If

'Set the %complete for the task
If Tsk.PercentComplete >= 0 And Tsk.PercentComplete <= 100 Then
.SetPercentComplete currentrow, Tsk.PercentComplete
End If

'Display progress in the status bar
.SetStatusMessage "task: " + Str(currentrow)

'Figure out which page the current task is on
NewPage = Fix((currentrow - 1) / LinesPerPage) + 1

'If necessary, switch to a new page
If NewPage > currentpage Then
.SetCurrentPage NewPage
currentpage = NewPage
End If

addblankrow:
Next Tsk

'Set the Milestones Professional schedule's start and end dates, based on the dates in MS Project
.SetEndDate Format(ActiveProject.ProjectFinish, "mm/dd/yy")
.SetStartDate Format(ActiveProject.ProjectStart, "mm/dd/yy")
.SetCurrentPage 1

End With

GoTo ExitLabel

ExitLabel:

Exit Sub

End Sub

Try this example:

1		Download ProjectExample2.zip
2		Extract the ProjectExample2.mtp file to your default Milestones Professional Template folder.
3		Extract the ProjectExample2.mpp file to a folder on your computer. (Anywhere you might normally save your Microsoft Project schedules.
4		Start Microsoft Project, and open the Project Example2.mpp file.
5		When asked if you want to enable macros, be sure to say yes.
6		In Microsoft Project, choose Macro-Macros on the Tools menu.
7		Click once on the macro named ProjectExample2.
8		Click the Run button.
		This should start Milestones Professional and produce the schedule illustrated above.

Click here to visit our main programmer's page.