Milestones Professional Automation: Microsoft Project VBA Examples

Warning: The information on these pages should only be used by software developers who are familiar with a Windows programming environment. KIDASA does not take responsibility for any damage caused to your information or computer due to programming errors.

Project VBA Example #1

Here’s a simple example of how Milestones Professional’s OLE Automation can be used to reformat a Microsoft Project schedule for printing on a single page on a large format plotter.

The Microsoft Project schedule (142 tasks):

project1a

The Milestones schedule formatted for a plotter:
project1b

To try this example:

ProjectExample.mpp (MS Project File with “MilestonesPlotter” Visual Basic Program) + one template

Click here to visit our main programmer’s page.

Project VBA 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.

project2a

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
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.

Project VBA Example #3

This example uses Visual Basic (VB) to show how an application can extract information from Microsoft Project and create a Milestones Professional schedule.

In addition, this example shows how to use many of the methods and properties in the Milestones Professional OLE Automation interface.

  • Set up columns for a schedule
  • Build a legend
  • Set grid lines and shading
  • Build a title
  • Set up the toolbox symbology
  • Set properties for individual symbols
  • Extract information from MS Project, outside of MS Project VBA
  • Set up an outlined column

VISUAL BASIC CODE 

Sub Main()

Dim objproject, objmilestones, tasks, T As Object

'Create the Milestones object
Set objmilestones = CreateObject("Milestones")

'Create the MS Project object
Set objproject = GetObject("c:\test\projectexample.mpp")

'Create the tasks object
Set tasks = objproject.tasks
If tasks.Count < 1 Then
MsgBox "No tasks in project file"
End
End If

'Start Milestones
objmilestones.Activate

'Set Schedule start and end dates
objmilestones.SetStartDate objproject.Start
objmilestones.SetEndDate objproject.Finish

'Format the schedule

'first, make sure there are no columns
For x = 1 To 10
objmilestones.SetColumnWidth x, 0#
Next x

'set up one column on the left side of the schedule
objmilestones.SetColumnWidth 1, 2.5

'it will be outlined, so set the amount to indent for each outline level
objmilestones.SetColumnProperty 1, "Indent", 0.2

'make it left-justified
objmilestones.SetColumnProperty 1, "TextAlign", 0

'add a column heading
objmilestones.SetColumnProperty 1, "ColumnHeadingLine1", "Task"
objmilestones.SetColumnProperty 1, "ColumnHeadingLine2", "Name"

'set up date headings
objmilestones.SetDateHeading 1, "Yearly", 1
objmilestones.SetDateHeading 2, "Monthly", 4
objmilestones.SetDateHeading 3, "None", 0
objmilestones.SetDateHeading 4, "None", 0

'we will have 22 tasks on each page
objmilestones.SetLinesPerPage 22

'add a curtain to shade the first 15 days of January
objmilestones.AddCurtain "01/01/1999", "01/15/1999"
objmilestones.SetCurtainProperties 1, "01/01/1999", "01/15/1999", 2, 4, 8, 0

'Add titles using information in MS Project file
objmilestones.SetTitle1 "Title: " + objproject.Title
objmilestones.SetTitle2 "Subject: " + objproject.Subject
objmilestones.SetTitle3 "Author: " + objproject.Author

'set up the symbology for summary tasks
objmilestones.SetToolboxSymbolProperty 1, "Type", 40 'triangle
objmilestones.SetToolboxSymbolProperty 1, "DatePosition", 13 'hide
objmilestones.SetToolboxSymbolProperty 1, "FillColor", 18 'black
objmilestones.SetToolboxHorizontalConnectorProperty 1, "Type", 20 'Upper bar
objmilestones.SetToolboxHorizontalConnectorProperty 1, "FillColor", 18 'Black

'set up the symbology for non-summary tasks
objmilestones.SetToolboxSymbolProperty 3, "Type", 45 'circled triangle-small
objmilestones.SetToolboxSymbolProperty 3, "DatePosition", 13 'hide
objmilestones.SetToolboxHorizontalConnectorProperty 2, "Type", 20 'Upper bar
objmilestones.SetToolboxHorizontalConnectorProperty 2, "FillColor", 4 'Blue
objmilestones.SetToolboxHorizontalConnectorProperty 2, "ShadowColor", 7 'Gray

'set up symbology for critical tasks
objmilestones.SetToolboxHorizontalConnectorProperty 3, "Type", 20 'Upper bar
objmilestones.SetToolboxHorizontalConnectorProperty 3, "FillColor", 6 'Red
objmilestones.SetToolboxSymbolProperty 5, "Type", 40 'triangle
objmilestones.SetToolboxSymbolProperty 5, "DatePosition", 13 'hide
objmilestones.SetToolboxSymbolProperty 5, "FillColor", 6 'Red

'set up symbology for one-day events (milestones)
objmilestones.SetToolboxSymbolProperty 7, "Type", 3
objmilestones.SetToolboxSymbolProperty 7, "FillColor", 1 'Aqua

'set up the legend
objmilestones.SetLegendHeight 1#
objmilestones.SetLegendProperty "entriesperrow", 3
objmilestones.SetLegendSymbology 1, 1, 1, 1 ' summary
objmilestones.SetLegendText 1, "Summary", ""
objmilestones.SetLegendText 2, "Planned", ""
objmilestones.SetLegendText 3, "Critical", ""
objmilestones.SetLegendSymbology 2, 3, 2, 3 'planned
objmilestones.SetLegendSymbology 3, 5, 3, 5 'critical

'loop through the list of MS Project tasks and build
'Milestones schedule
currentrow = 0

For Each T In tasks
currentrow = currentrow + 1

objmilestones.settasklinegrid currentrow, 0, 7, 0

objmilestones.settasklinegrid currentrow, 1, 7, 1

If T.Summary = True Then
symboltype = 1
connectortype = 1
Else
symboltype = 3
connectortype = 2
End If

If T.Critical = True Then
symboltype = 5
connectortype = 3
End If

'add text to the task name column
objmilestones.PutCell currentrow, 1, T.Name

If Format(T.Start, "MM/DD/YY") = Format(T.Finish, "MM/DD/YY") Then

'single day milestones
objmilestones.addsymbol currentrow, Format(T.Finish, "MM/DD/YY"), 7
If T.Critical Then objmilestones.SetSymbolProperty currentrow, 1, "FillColor", 6

Else

'add start+finish dates
objmilestones.addsymbol currentrow, Format(T.Start, "MM/DD/YY"), symboltype, connectortype, 2
objmilestones.addsymbol currentrow, Format(T.Finish, "MM/DD/YY"), symboltype

If T.Critical = True Then

'color critical symbols red
objmilestones.SetSymbolProperty currentrow, 1, "FillColor", 6
objmilestones.SetSymbolProperty currentrow, 2, "FillColor", 6

'shade the critical tasks
objmilestones.settasklineshade currentrow, 0, 15
objmilestones.settasklineshade currentrow, 1, 15

End If

End If

'set the outline level
objmilestones.setoutlinelevel currentrow, T.Outlinelevel

'set the font size
objmilestones.settasklinefontheight currentrow, 10

'display a message in the status bar
objmilestones.setstatusmessage "Task: " + Str(currentrow)
Next T

'keep the schedule open
objmilestones.KeepScheduleOpen

'Maximize the Milestones window
objmilestones.MaximizeWindow

Exit Sub

End Sub

Try this example:

  1. Create a new VB Project and copy the above code into your project.
  2. Change the MPP file reference to reference one of your MS Project files.
  3. Run the Program.

Click here to visit our main programmer’s page.