Microsoft Project Code 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   (Milestones interface calls shown in Blue)
   
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.