Example 10 - Milestones automation feature demonstration

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 MS Project tasks object

  Set tasks = objproject.tasks

  If tasks.Count < 1 Then

    MsgBox "No tasks in project file"

    End

  End If

with objmilestones 

  'Start Milestones

  .Activate

  'Set Schedule start and end dates

  .SetStartDate objproject.Start

  .SetEndDate objproject.Finish

  'Format the schedule

  'first, make sure there are no columns

  For x = 1 To 10

    .SetColumnWidth x, 0#

  Next x

  'set up one column on the left side of the schedule

  .SetColumnWidth 1, 2.5

  'it will be outlined, so set the amount to indent for each outline level

  .SetColumnProperty 1, "Indent", 0.2

  'make it left-justified

  .SetColumnProperty 1, "TextAlign", 0

  'add a column heading

  .SetColumnProperty 1, "ColumnHeadingLine1", "Task"

  .SetColumnProperty 1, "ColumnHeadingLine2", "Name"

  'set up date headings

  .SetDateHeading 1, "Yearly", 1

  .SetDateHeading 2, "Monthly", 4

  .SetDateHeading 3, "None", 0

  .SetDateHeading 4, "None", 0

  'we will have 22 tasks on each page

  .SetLinesPerPage 22

  'add a curtain to shade the first 15 days of January

  .AddCurtain "01/01/2009", "01/15/2009"

  .SetCurtainProperties 1, "01/01/2009", "01/15/2009", 2, 4, 8, 0

  'Add titles using information in MS Project file

  .SetTitle1 "Title : " + objproject.Title

  .SetTitle2 "Subject: " + objproject.Subject

  .SetTitle3 "Author: " + objproject.Author

  'set up the symbology for summary tasks

  .SetToolboxSymbolProperty 1, "Type", 40 'triangle

  .SetToolboxSymbolProperty 1, "DatePosition", 13 'hide

  .SetToolboxSymbolProperty 1, "FillColor", 18 'black

  .SetToolboxHorizontalConnectorProperty 1, "Type", 20 'Upper bar

  .SetToolboxHorizontalConnectorProperty 1, "FillColor", 18 'Black

  'set up the symbology for non-summary tasks

  .SetToolboxSymbolProperty 3, "Type", 45 'circled triangle-small

  .SetToolboxSymbolProperty 3, "DatePosition", 13 'hide

  .SetToolboxHorizontalConnectorProperty 2, "Type", 20 'Upper bar

  .SetToolboxHorizontalConnectorProperty 2, "FillColor", 4 'Blue

  .SetToolboxHorizontalConnectorProperty 2, "ShadowColor", 7  'Gray

  'set up symbology for critical tasks

  .SetToolboxHorizontalConnectorProperty 3, "Type", 20 'Upper bar

  .SetToolboxHorizontalConnectorProperty 3, "FillColor", 6 'Red

  .SetToolboxSymbolProperty 5, "Type", 40 'triangle

  .SetToolboxSymbolProperty 5, "DatePosition", 13 'hide

  .SetToolboxSymbolProperty 5, "FillColor", 6 'Red

  'set up symbology for one-day events (milestones)

  .SetToolboxSymbolProperty 7, "Type", 3

  .SetToolboxSymbolProperty 7, "FillColor", 1 'Aqua

  'set up the legend

  .SetLegendHeight 1#

  .SetLegendProperty "entriesperrow", 3

  .SetLegendSymbology 1, 1, 1, 1 ' summary

  .SetLegendText 1, "Summary", ""

  .SetLegendText 2, "Planned", ""

  .SetLegendText 3, "Critical", ""

  .SetLegendSymbology 2, 3, 2, 3 'planned

  .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

    .settasklinegrid currentrow, 0, 7, 0

    .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

    .PutCell currentrow, 1, T.Name

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

    'single day milestones

      .addsymbol currentrow, Format(T.Finish, "MM/DD/YY"), 7

      If T.Critical Then objmilestones.SetSymbolProperty currentrow, 1, "FillColor", 6

    Else

    'add start+finish dates

      .addsymbol currentrow, Format(T.Start, "MM/DD/YY"), symboltype, connectortype, 2

      .addsymbol currentrow, Format(T.Finish, "MM/DD/YY"), symboltype

      If T.Critical = True Then

        'color critical symbols red

        .SetSymbolProperty currentrow, 1, "FillColor", 6

        .SetSymbolProperty currentrow, 2, "FillColor", 6

        'shade the critical tasks

        .settasklineshade currentrow, 0, 15

        .settasklineshade currentrow, 1, 15

      End If

    End If

    'set the outline level

    .setoutlinelevel currentrow, T.Outlinelevel

    'set the font size

    .settasklinefontheight currentrow, 10

    'display a message in the status bar

    .setstatusmessage "Task: " + Str(currentrow)

  Next T

  'Maximize the Milestones window

  . MaximizeWindow

  'keep the schedule open

  .KeepScheduleOpen

Exit Sub

End Sub