Ao set relative dates.mmbas

From ActivityOwnerWiki
Jump to: navigation, search
'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