WD: Gregorian and Julian Date Functions for WordBasic Macros

ID: Q94072

The information in this article applies to:

Microsoft Word for Windows, versions 2.0, 2.0a, 2.0a-CD, 2.0b, 2.0c

SUMMARY

The Word for Windows WordBasic macro language contains no date functions to handle such complex date calculations as conversion between Gregorian and Julian dates. This article offers a set of functions that convert between Gregorian and Julian dates.

MORE INFORMATION

The Gregorian calendar system describes dates as days, months, and years. The Julian number system describes a date as an integer. You can use a Julian date to perform complex date calculations, such as the following:

What is the date 50 days from today?

How many days are there between two dates?

What day of the week is your birthday in the year 2000?

You can use the functions and subroutine provided below in WordBasic macros to perform such calculations.

WARNING: ANY USE BY YOU OF THE CODE PROVIDED IN THIS ARTICLE IS AT YOUR OWN RISK. Microsoft provides this macro code "as is" without warranty of any kind, either express or implied, including but not limited to the implied warranties of merchantability and/or fitness for a particular purpose. The macro code below contains the following functions and subroutine:

Functions


   CalToJulian    Converts Gregorian date to Julian number
   LongInt        Performs INT function for large values
   LongMod        Performs MOD function for large values
   WeekDay$       Returns day of week in text format

Subroutine


   SubRoutine: JulianToCal    Converts Julian number to Gregorian date

To use these functions and subroutine, copy the macro code below into your macro or into a macro that serves as a WordBasic function and subroutine library. You can then call the functions or subroutine from within your macro, or from your macro library. For more information on using functions and subroutines, see pages 54-60 in "Using WordBasic."

NOTE: To successfully use these functions, you must set the MM/DD/YYYY date format. To do this, use the International option in Windows Control Panel or add the following line to the [Microsoft Word 2.0] section of your Windows WIN.INI file:

DATEFORMAT=MM/DD/YYYY

The sample macro below checks for a "DATEFORMAT=" string in your WIN.INI file. If the string exists, the macro resets it to the correct format. If the string does not exist, the macro creates the setting using the SetProfileString macro command.

Sample Macro Using the Date Functions


   Sub MAIN
   
   ' The formulas in this macro accurately convert any Gregorian date
   ' between 3/1/0 and 12/31/9999 to its Julian day number. The
   ' reverse calculation (from Julian day number to Gregorian) seems to
   ' have no top end limit.
   ' The four variables rDay, rMonth, rYear, and wDay must be defined.
   ' You must allocate a memory location to these variables before passing
   ' them to the JulianToCal subroutine to obtain consistent results.
   
   Dim rDay, rMonth, rYear, wDay
   '******************************************************************
   '   This routine sets dateformat to proper format. See routine at
   '   end of macro, which returns dateformat back to original format.
   
   App$ = "Microsoft Word 2.0"
   Item$ = "DateFormat"
   Item2$ = "DateBak"
   dFormat$ = GetProfileString$(App$, Item$)
   SetProfileString App$, Item2$, dFormat$
   SetProfileString App$, Item$, "MM/DD/YYYY"
   '******************************************************************
   
   On Error Goto Abort  'error trapping
   
   '  Gets number of days to be used in calculation.
   dNum$ = InputBox$("Enter number of days to calculate from today.",\ 
   "Days in Future", "1")
   
   tDay$ = Date$()                        'Gets current Date
   rDay = Val(Mid$(tDay$, 4, 2))          'Parses date for day value
   rMonth = Val(Left$(tDay$, 2))          'Parses date for month value
   rYear = Val("19" + Right$(tDay$, 2))   'Parses date for year value
                                          'Assumes value is 19xx
   
   ' Calls function CalToJulian, which returns the Julian day number
   ' for the Gregorian date value given as arguments. Date value must
   ' be in the following format:
   ' rDay   (2 digits)
   ' rMonth (2 digits)
   ' rYear  (4 digits)   Note. If rYear is 2 digits, the Julian will be
   ' calculated incorrectly.
   
   jNum = CalToJulian(rDay, rMonth, rYear)
   
   jNum2 = jNum + Val(dNum$)   'Julian # for today's date+number of days
   
   ' This calls the subroutine to convert a Julian day number back to the
   ' Gregorian date using the undocumented feature of passing multiple
   ' variables as arguments to the subroutine. When completed, returns
   ' the variables even if they have changed. This works even if the
   ' subroutine is in a separate macro. Word passes parameters to
   ' subroutines and functions "by reference".
   
   Call JulianToCal(jNum2, rDay, rMonth, rYear, wDay) ' Sets the variable
   '                                  that is passed to the message box.
   mText$ = dNum$ + " days from today it will be " + WeekDay$(wDay) + \ 
   Str$(rMonth) + " -" + Str$(rDay) + " -" + Str$(rYear) + "."
   ' Prints the message that shows the results of the calculations.
   
   MsgBox mText$
   Goto Done
   Abort: :                      'error trapping
   MsgBox "Macro aborted!"
   Done:
   '*****************************************************************
   '   This routine returns dateformat back to original format
   dFormat$ = GetProfileString$(App$, Item2$)
   SetProfileString App$, Item$, dFormat$
   '*****************************************************************
   
   End Sub
   '__________________________________________________________________
   '*********************DATE FUNCTIONS AND SUBROUTINE ***************
   '__________________________________________________________________
   ' This is the function that converts a Gregorian date to the
   ' equivalent Julian day number. It consists of two equations. The
   ' first sets the value of y, the second sets the value returned by the
   ' function. The second formula requires the LongInt function because
   ' 32,676 (2-bytes) is the maximum size the INT function can handle.
   
   Function CalToJulian(tday, tmonth, tyear)
   y = tyear +(tmonth - 2.85) / 12
   CalToJulian = LongInt(LongInt(LongInt(367 * y) - LongInt(y) - 0.75 *\ 
   LongInt(y) + tday)- 0.75 * LongInt(y / 100)) + 1721115
   End Function
   
   ' This is the subroutine that converts a Julian day number to the
   ' equivalent Gregorian date. It consists of 11 formulas of which 9
   ' are used to calculate the date. The values rDay, rMonth, rYear,
   ' and wDay are computed, and then returned as values to the routine
   ' that called them.
   ' The last equation, wDay = LongMod((jdn+1), 7), returns a value for
   ' the week day where Sunday = 0, Monday = 1, Tuesday = 3, . . . ,
   ' Saturday = 6. It requires the LongMod function because 32,676
   ' (2-bytes) is the max size that the MOD function can handle.
   
   Sub JulianToCal(jdn, rDay, rMonth, rYear, wDay)
   N = jdn - 1721119
   C = LongInt((N - 0.2) / 36524.25)
   N1 = N + C - LongInt(C / 4)
   Y1 = LongInt((N1 - 0.2) / 365.25)
   N2 = N1 - LongInt( 365.25 * Y1)
   M1 = LongInt((N2 - 0.5) / 30.6)
   rDay = LongInt(N2 - 30.6 * M1 + 0.5)
   If M1 > 9 Then
     rYear = Y1 + 1
     rMonth = M1 - 9
   Else
     rYear = Y1
     rMonth = M1 + 3
   EndIf
   wDay = LongMod((jdn + 1), 7)
   End Sub
   
   ' This is the LongInt function mentioned above.
   Function LongInt(TempVal)
   TempStr = InStr(Str$(TempVal), ".")
   LongInt = Val(Left$(Str$(TempVal), TempStr - 1))
   End Function
   
   ' This is the LongMod function mentioned above.
   Function LongMod(num, div)
   tNum = num / div
   LongMod = num -(LongInt(tNum) * div)
   End Function
   ' This is a function that returns the day of the week in text for
   ' nicer output.
   
   Function WeekDay$(num)
   Select Case num
   Case 0
     WeekDay$ = "Sunday"
   Case 1
     WeekDay$ = "Monday"
   Case 2
     WeekDay$ = "Tuesday"
   Case 3
     WeekDay$ = "Wednesday"
   Case 4
     WeekDay$ = "Thursday"
   Case 5
     WeekDay$ = "Friday"
   Case 6
     WeekDay$ = "Saturday"
   Case Else
   End Select
   End Function

REFERENCES

"Using WordBasic," by WexTech Systems and Microsoft, pages 54-60, 227, 293-294

"Microsoft Press Computer Dictionary," copyright 1991, pages 164, 200

Additional query words: numerals

Keywords : kbcode kbdta kbmacroexample
Version : WINDOWS:2.0,2.0a,2.0a-CD,2.0b,2.0c
Platform : WINDOWS
Issue type : kbhowto