Task Color Font

[SMERTZ]

I am trying to see if I can get tasks that are due this week to appear in
red each time a project is opened. In searching these boards I found the
code below. It has been many years since I have seen VB, and I don't know
any of the objects available in Project 2002, but this looks like it is
comparing to a BASELINE.

How can I simply autorun a macro when the Project file is opened that turns
tasks RED if they are due to complete ths week.

Thanks in advance.


Sub TaskColor()
Dim oTask As Object

For Each oTask In ActiveProject.Tasks
'Debug.Print oTask.Name, oTask.ID,
oTask.FinishVariance((ActiveProject.HoursPerDay) * 60)
If Not oTask Is Nothing Then
If oTask.Summary = False Then

'If the finish variance is greater than 1 day(s)
If oTask.FinishVariance / ((ActiveProject.HoursPerDay) * 60) > 1
Then
SelectRow Row:=oTask.ID, RowRelative:=False
Font Color:=pjRed

'If the finish variance is Less than 1 day(s)
ElseIf oTask.FinishVariance / ((ActiveProject.HoursPerDay) * 60)
< 0 Then
SelectRow Row:=oTask.ID, RowRelative:=False
Font Color:=pjGreen
Else
SelectRow Row:=oTask.ID, RowRelative:=False
Font Color:=pjBlack
End If
End If
End If
Next oTask
End Sub

 

[Jan De Messemaeker]

Hi Smertz,

Providing I can translate "This week" as "within the next five days" this
could help you:

Sub Within5d()
dim Job as task
Dim InAWeek as date
Dim HPD as single
Filterapply "All Tasks"
Outlineshowalltasks
hpd=activeproject.hoursperday
InAWeek=application.dateadd(vba.date, (300*hpd))
for each job in activeproject.tasks
if not job is nothing then
SelectRow Row:=job.ID, RowRelative:=False
Font Color:=pjBlack
if not job.summary then
if not job.remainingduration=0 then
if job.finish<inaweek then
SelectRow Row:=job.ID, RowRelative:=False
Font Color:=pjred
endif 'finish
endif 'finished
endif 'summary
endif 'nothing
next job
end sub

Note that I would not recolor but set a flag field and make a filter on that
flag field.
But I give what you ask for.

Hope this helps,