Visual Basic Example #2

Here's an example which illustrates many of Milestones Professional's OLE Automation methods. It builds a simple schedule, adds curtains, shades a task line and adds a duration SmartColumn. Try this example

The Code:

Dim objproject, objmilestones, tasks, T As Object
'Create the Milestones object
Set objmilestones = CreateObject("Milestones")

SUBSTITUTE YOUR OWN FILE HERE

'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

objmilestones.SetSummaryBarDisplay 0

objmilestones.setcolumnproperty 1, "SmartColumn", "none"

'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, 1, 7, 17

    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, 6
        objmilestones.settasklineshade currentrow, 1, 6
       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

To try this example:

Click here to download a Zip file (MilestonesVBExample2.Zip) containing the above VB code. Note that you will need Microsoft Project and a Microsoft Project MPP file (any MPP file with tasks will work) to run this example. In the program, change the referenced MPP file name to a file name of one of the MPP files on your computer.

Click here to visit our main programmer's page.