Ao set relative dates.mmbas

'ao_set_relative_dates 27Apr09 http://creativecommons.org/licenses/by-nc-nd/3.0/ http://activityowner.com Option Explicit 'Syntax: category D-x, D+x, S-x, S+x Const DueRefMinus="D-" Const DueRefPlus="D+" Const StartRefMinus="S-" Const StartRefPlus="S+" Sub Main Dim t As Topic Dim x As Date Dim cleanup As Boolean x= DateValue(InputBox("Enter Reference date for project", "Relative Project Dates",Str(Date))) cleanup = MsgBox("Do you want to remove relative date codes?",vbYesNo)=vbYes For Each t In ActiveDocument.Range(mmRangeAllTopics) SetDateRel t, x, DueRefMinus, cleanup SetDateRel t, x, DueRefPlus, cleanup SetDateRel t, x, StartRefPlus, cleanup SetDateRel t, x, StartRefMinus, cleanup Next End Sub Sub SetDateRel(ByRef t As Topic, d As Date, codestr As String, cleanup As Boolean) Dim sign As Integer sign=1 If InStr(codestr,"-")>0 Then sign=-1 With t.Task If InStr(.Categories,codestr)>0 Then If InStr(codestr,"D")>0 Then .DueDate=DateAdd("d",sign*findamount(.Categories,codestr),d) Else .StartDate=DateAdd("d",sign*findamount(.Categories,codestr),d) End If			If cleanup Then .Categories=Replace(.Categories,codestr & findamount(.Categories,codestr),"") End If	End With End Sub Function findamount(ByVal cat As String, ByRef prefix As String) As Integer cat=Right(cat,Len(cat)-InStr(cat,prefix)-Len(prefix)+1) If InStr(cat,",")>0 Then findamount=Val(Left(cat,InStr(cat,",")-1)) Else findamount=Val(cat) End If End Function