Attribute VB_Name = "Module1"
Option Explicit
Option Base 1

' ----------------------------------------------------------------------
' Cavernian Calendar Calculator for MS Excel
'
' Copyright © 2004 by Brett Middleton (brettm@uga.edu), except as
' noted below.
'
' D'ni, the D'ni language, and the D'ni timekeeping system are © Cyan,
' Inc. and Cyan Worlds, Inc.  D'ni is a Registered Trademark of Cyan,
' Inc. and Cyan Worlds, Inc. All rights reserved.
'
' This program is free software; you can redistribute it and/or
' modify it under the terms of the GNU General Public License
' as published by the Free Software Foundation; either version 2
' of the License, or (at your option) any later version.
'
' This program is distributed in the hope that it will be useful,
' but WITHOUT ANY WARRANTY; without even the implied warranty of
' MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
' GNU General Public License for more details.
'
' You should have received a copy of the GNU General Public License
' along with this program; if not, write to the Free Software
' Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
' 02111-1307, USA.
'
' The license terms are also available on the World Wide Web and may
' be reviewed at http://www.gnu.org/copyleft/gpl.html.
'
' -------------------
' Module Description:
' -------------------
'
' Collection of subroutines and functions used in converting date/time
' values among various representational systems, including: Gregorian
' Date (CE/BCE), Julian Serial Number (JSN), Cavernian Date (DE - D'ni
' Era), and Atrian Serial Number (ASN). (The ASN is named in honor of
' Atrus, son of Gehn. It is the equivalent of the Julian Serial Number
' for a date/time value in the D'ni timekeeping system.)
'
' -----------------
' Revision History:
' -----------------
'
' 2004.10.30: Version 1.0 complete. Developed in MS Excel 2000 SR-1.
' ----------------------------------------------------------------------

' Gregorian date/time used as basis for conversions between Cavernian
' and Gregorian date/times. This is the date/time on which the D'ni New
' Year (Leefo 1) began in 1998 CE. The time is UTC, aka GMT.

Private Const Base_Year As Long = 1998              ' Gregorian date
Private Const Base_Month As Integer = 4
Private Const Base_Day As Integer = 21

Private Const Base_Hour As Integer = 10             ' 24-hr clock time
Private Const Base_Minute As Integer = 35
Private Const Base_Second As Integer = 18

Private Const Base_JSN As Double = 729806.441180555 ' Julian SN of base

' Cavernian date/time used as basis for conversions between Cavernian
' and Gregorian date/times. This is the date/time of the D'ni New Year
' that began in 1998 CE. (Leefo 1, 9654 DE, 0:00:00:00 gahrtahvotee.)

Private Const Base_Hahr As Long = 9654               ' Cavernian date
Private Const Base_Vailee As Integer = 1             ' Vailee = Leefo
Private Const Base_Yahr As Integer = 1

Private Const Base_Gahrtahvo As Integer = 0
Private Const Base_Tahvo As Integer = 0
Private Const Base_Gorahn As Integer = 0
Private Const Base_Prorahn As Integer = 0

Private Const Base_ASN As Double = 1#                ' Atrian SN of base

' Gregorian date/time relationships and miscellaneous constants for
' Gregorian/Julian date calculations.

Private Const Days_per_Century As Double = 36524.25
Private Const Days_per_Year As Double = 365.25

Private Const Seconds_per_Day As Long = 86400
Private Const Seconds_per_Hour As Integer = 3600
Private Const Seconds_per_Minute As Integer = 60

Private Const QuarterDay As Double = 0.25

' Cavernian date/time relationships and miscellaneous constants for
' Cavernian/Atrian date calculations.

Private Const Vaileetee_per_Hahr As Integer = 10
Private Const Yahrtee_per_Hahr As Integer = 290
Private Const Yahrtee_per_Vailee As Integer = 29

Private Const Gahrtahvotee_per_Yahr As Integer = 5
Private Const Tahvotee_per_Gahrtahvo As Integer = 25
Private Const Gorahntee_per_Tahvo As Integer = 25

Private Const Prorahntee_per_Yahr As Long = 78125
Private Const Prorahntee_per_Gahrtahvo As Integer = 15625
Private Const Prorahntee_per_Tahvo As Integer = 625
Private Const Prorahntee_per_Gorahn As Integer = 25

Private Const QuarterYahr As Double = 0.25

' Gregorian/Cavernian conversion factors.

Private Const Days_per_Hahr As Double = 365.2421875
Private Const Days_per_Yahr As Double = 1.25945581896552

Private Const Yahrtee_per_Day As Double = 0.793993711364463

' ----------------------------------------------------------------------
' Utility functions for input validation, converting month names, and
' converting vailee names and numbers. (Note that VBA has a built-in
' MonthName function for converting month numbers.)
' ----------------------------------------------------------------------

Function IsLeapYear(YearX As Long) As Boolean

' ----------------------------------------------------------------------
' Determine if the input common-era year (including year 0 and negative
' years) is a leap year. Leap years are years divisible by 4, unless
' they are century years that are not divisible by 400.
' ----------------------------------------------------------------------

IsLeapYear = ((YearX Mod 4 = 0) _
    And ((YearX Mod 100 <> 0) Or (YearX Mod 400 = 0)))

End Function

Function LastDay(MonthX As Integer, YearX As Long) As Integer

' ----------------------------------------------------------------------
' Determine the last day of a given month in a given common-era year,
' including year 0 and negative years. The result can be used to
' validate the day argument of functions that take a Gregorian date
' as input. The IsLeapYear function is used to determine if February
' has 28 or 29 days.
' ----------------------------------------------------------------------

Select Case MonthX
    Case 1, 3, 5, 7, 8, 10, 12
        LastDay = 31

    Case 4, 6, 9, 11
        LastDay = 30

    Case 2
        If IsLeapYear(YearX) Then
            LastDay = 29
        Else
            LastDay = 28
        End If

    Case Else
        Err.Raise xlErrValue
End Select

End Function
Function MonthNumber(MonthName As Variant) As Integer

' ----------------------------------------------------------------------
' Determine the month number given the name. If the name is invalid,
' the return value will be zero.
' ----------------------------------------------------------------------

Dim MonthNames As Variant

MonthNames = Array("January", "February", "March", "April", "May", _
    "June", "July", "August", "September", "October", "November", _
    "December")

For MonthNumber = 1 To 12
    If StrComp(MonthNames(MonthNumber), MonthName, vbTextCompare) = 0 _
        Then Exit For
Next MonthNumber

If MonthNumber > 12 Then MonthNumber = 0

End Function

Function VaileeNumber(VaileeName As Variant) As Integer

' ----------------------------------------------------------------------
' Determine the vailee number given the name. If the name is invalid,
' the return value will be zero.
' ----------------------------------------------------------------------

Dim VaileeNames As Variant
        
VaileeNames = Array("Leefo", "Leebro", "Leesahn", "Leetar", "Leevot", _
    "Leevofo", "Leevobro", "Leevosahn", "Leevotar", "Leenovoo")

For VaileeNumber = 1 To Vaileetee_per_Hahr
    If StrComp(VaileeNames(VaileeNumber), VaileeName, vbTextCompare) = 0 _
        Then Exit For
Next VaileeNumber

If VaileeNumber > Vaileetee_per_Hahr Then VaileeNumber = 0

End Function

Function VaileeName(VaileeNumber As Integer) As String

' ----------------------------------------------------------------------
' Determine the vailee name given the number. If the number is invalid,
' the #VALUE! error will be raised.
' ----------------------------------------------------------------------

Dim VaileeNames As Variant

If (VaileeNumber < 1 Or VaileeNumber > Vaileetee_per_Hahr) Then
    Err.Clear
    Err.Raise xlErrValue
End If

VaileeNames = Array("Leefo", "Leebro", "Leesahn", "Leetar", "Leevot", _
    "Leevofo", "Leevobro", "Leevosahn", "Leevotar", "Leenovoo")

VaileeName = VaileeNames(VaileeNumber)

End Function

' ----------------------------------------------------------------------
' Gregorian/Julian conversion routines.
' ----------------------------------------------------------------------

Function JulianSerialGD(IsCommonEra As Boolean, _
    YearX As Long, MonthX As Variant, DayX As Integer, _
    Optional HourX As Integer = 0, Optional MinuteX As Integer = 0, _
    Optional SecondX As Integer = 0) As Double

' ----------------------------------------------------------------------
' Convert a Gregorian date/time to a Julian serial number (JSN), which
' is the number of days and fractions that have elapsed since a base
' date of midnight, March 1, 0 CE.
'
' The month may be input as either a number or a name. The year must be
' identified as Common Era (CE) or Before Common Era (BCE) by setting
' the IsCommonEra argument to TRUE (for CE) or FALSE (for BCE). Note
' that a zero or negative CE year may be provided instead of a BCE year,
' in which case IsCommonEra should be TRUE.
'
' As an option, time information (24-hour clock) can be included, and
' will be expressed as the fractional part of the JSN. If not provided,
' the time is assumed to be midnight (00:00:00).
'
' The algorithm is based on one provided by Peter Baum's "Date
' Algorithms" Web site at http://vsg.cape.com/~pbaum/date/date0.htm.
' It can handle any Gregorian date within a range of about 10 million
' years, including dates in the proleptic Gregorian calendar.
' ----------------------------------------------------------------------

Dim TmpYear As Long, TmpMonth As Integer
Dim YearDays As Long, MonthDays As Integer, JulianDay As Long
Dim HourSecs As Long, MinuteSecs As Integer, TotalSecs As Long
Dim DayFraction As Double

Err.Clear   ' Clear out the Error object, just in case we need it.

' If the year is in BCE format (1 BCE, 2 BCE, etc.), it must be changed
' to CE format (0 CE, -1 CE, etc.) for the calculation. BCE years must
' be positive and non-zero.

If IsCommonEra Then
    TmpYear = YearX

Else
    If YearX < 1& Then
        Err.Raise xlErrValue
    Else
        TmpYear = -(YearX - 1&)
    End If
End If

' Determine whether the input month is a number or a name. If a name,
' convert it to a number. The month will be 0 if there is no match or
' if the variable type isn't readily converted to integer.

Select Case VarType(MonthX)
    Case vbInteger, vbLong, vbSingle, vbDouble
        TmpMonth = CInt(MonthX)
    
    Case vbString
        TmpMonth = MonthNumber(MonthX)
    
    Case Else
        TmpMonth = 0
End Select

' Check for month or day being out of valid range.

If (TmpMonth < 1 Or TmpMonth > 12) Then Err.Raise xlErrValue

If (DayX < 1 Or DayX > LastDay(TmpMonth, TmpYear)) Then _
    Err.Raise xlErrValue

' If the month is January or February, the date must be modified to push
' the month back to the end of the preceeding year, as "month" 13 or 14.
' This ensures that all leap days since the base date fall as the last
' day of a "year". See the Baum algorithms.

If TmpMonth < 3 Then
    TmpMonth = TmpMonth + 12
    TmpYear = TmpYear - 1&
End If

' Determine the number of days accounted for by full years since
' Gregorian year 0. Adjust for leap days that occurred in the span.

YearDays = Int(Days_per_Year * TmpYear) - Int(0.01 * TmpYear) + _
    Int(0.0025 * TmpYear)

' Determine the number of days accounted for by months preceeding the
' current month in the current year.

MonthDays = Fix(((153 * TmpMonth) - 457) / 5)

' Sum the day counts, including the current day of the current month,
' to get the number of whole days elapsed.

JulianDay = CLng(DayX) + CLng(MonthDays) + YearDays

' Ensure that the time is properly expressed on a 24-hour clock.

If ((HourX < 0 Or HourX > 23) Or (MinuteX < 0 Or MinuteX > 59) Or _
    (SecondX < 0 Or SecondX > 59)) Then Err.Raise xlErrValue

' Convert the time to a total number of seconds since midnight, and
' express it as a fraction of a full day.

HourSecs = CLng(HourX) * CLng(Seconds_per_Hour)
MinuteSecs = MinuteX * Seconds_per_Minute
TotalSecs = HourSecs + CLng(MinuteSecs) + CLng(SecondX)

DayFraction = CDbl(TotalSecs) / Seconds_per_Day

' Sum the day and time components and return the result.

JulianSerialGD = CDbl(JulianDay) + DayFraction

End Function

Sub GregorianJS(JulianSerial As Double, IsCommonEra As Boolean, _
    YearX As Long, MonthX As Integer, DayX As Integer, _
    Optional HourX As Integer, Optional MinuteX As Integer, _
    Optional SecondX As Integer)

' ----------------------------------------------------------------------
' Convert a Julian serial number (JSN) to a Gregorian date/time. The
' JSN is the number of days and fractions that have elapsed since a
' base date of midnight, March 1, 0 CE.
'
' If the calculated year is zero or negative, it is converted to BCE
' (Before Common Era) form, and IsCommonEra is set to false. Any
' fractional part of the JSN will be converted to a time-of-day value
' on a 24-hour clock.
'
' The algorithm is based on one provided by Peter Baum's "Date
' Algorithms" Web site at http://vsg.cape.com/~pbaum/date/date0.htm.
' It can handle any Gregorian date within a range of about 10 million
' years, including dates in the proleptic Gregorian calendar.
' ----------------------------------------------------------------------

Dim JulianDay As Long, TotalDays As Long, CorrectedDays As Double
Dim Centuries As Integer, LeapDays As Integer, Day_of_Year As Integer
Dim DayFraction As Double, TotalSecs As Long

' Extract the integer part of the Julian serial number, which is the
' Julian day number.

JulianDay = Int(JulianSerial)

' Because the last day in the span is always only a partial day, a
' small constant amount must be subtracted to ensure that the final
' inal calculation is off by less than one day. Then the INT function
' can eliminate the approximation error. A quarter of a day is a
' convenient value for this purpose. See the Baum article for details
' on the error function for the algorithm.

TotalDays = JulianDay
CorrectedDays = CDbl(TotalDays) - QuarterDay

' Determine the number of whole centuries that have elapsed, and the
' number of leap days that must be accounted for as a result.

Centuries = Int(CorrectedDays / Days_per_Century)
LeapDays = Centuries - Int(0.25 * Centuries)

' Determine the year part of the date.

YearX = Int((CorrectedDays + CDbl(LeapDays)) / Days_per_Year)

' Determine the day within the year and split it into month and
' day-of-month.

Day_of_Year = TotalDays + CLng(LeapDays) - Int(Days_per_Year * YearX)

MonthX = Fix(((5 * Day_of_Year) + 456) / 153)
DayX = Day_of_Year - Fix(((153 * MonthX) - 457) / 5)

' Convert to a year that starts January 1, rather than March 1.

If MonthX > 12 Then
    MonthX = MonthX - 12
    YearX = YearX + 1&
End If

' If the year is zero or negative, convert it to BCE form.

If YearX < 1& Then
    YearX = 1& - YearX
    IsCommonEra = False
Else
    IsCommonEra = True
End If

' Extract the fractional part of the Julian serial number, which is
' time of day expressed as the fraction of the total number of
' seconds in a day. Convert it to seconds, then extract the hour,
' minute, and second as a 24-hour time value. Because of possible
' precision errors in the binary representation of decimal numbers,
' the value is explicitly rounded to whole seconds, and then
' checked to be sure it didn't round up to a whole day.

DayFraction = JulianSerial - JulianDay

If DayFraction <> 0 Then
    TotalSecs = Round((DayFraction * Seconds_per_Day), 0)

    If TotalSecs >= Seconds_per_Day Then _
        TotalSecs = Seconds_per_Day - 1

    HourX = Fix(TotalSecs / CLng(Seconds_per_Hour))
    TotalSecs = TotalSecs - (CLng(HourX) * CLng(Seconds_per_Hour))

    MinuteX = Fix(TotalSecs / Seconds_per_Minute)

    SecondX = Round((TotalSecs - (MinuteX * Seconds_per_Minute)), 0)
Else
    HourX = 0
    MinuteX = 0
    SecondX = 0
End If

End Sub

Function GregorianStringJS(JulianSerial As Double, _
    Optional FormatOption As Byte = 0) As String

' ----------------------------------------------------------------------
' Convert a Julian serial number to a Gregorian date/time and format
' the result as a string. This is an interface to the GregorianJS
' subroutine.
'
' The format option code determines the content of the string:
'
'   0 = Compact date/time (default) = "y.m.d hh:mm:ss"
'   1 = Compact date only = "y.m.d"
'   2 = Year only = "y"
'   3 = Long date/time string = "hh:mm:ss, monthname d, y"
'   4 = Long date only = "monthname d, y"
'
' All strings are suffixed with the era designation. Leading zeros are
' omitted from year, month, and day values. Month names in long dates
' are mixed case.
' ----------------------------------------------------------------------

Dim IsCommonEra As Boolean, YearX As Long, MonthX As Integer
Dim DayX As Integer, HourX As Integer, MinuteX As Integer
Dim SecondX As Integer
Dim DateString As String, TimeString As String, EraString As String

' Call subroutine to perform the actual date conversion.

Call GregorianJS(JulianSerial, IsCommonEra, YearX, MonthX, DayX, _
    HourX, MinuteX, SecondX)

' Determine the era designation, using the modern scientific notation:
' "CE" (Common Era) instead of "AD", or "BCE" (Before Common Era)
' instead of "BC".

If IsCommonEra Then
    EraString = " CE"
Else
    EraString = " BCE"
End If
    
' Build date and time strings, according to format option.

Select Case FormatOption
    Case 0
        DateString = Format(YearX, "0\.") + Format(MonthX, "0\.") _
            + Format(DayX, "0")
        TimeString = Format(HourX, "\ 00\:") + _
            Format(MinuteX, "00\:") + Format(SecondX, "00")
        GregorianStringJS = DateString + TimeString + EraString

    Case 1
        DateString = Format(YearX, "0\.") + Format(MonthX, "0\.") _
            + Format(DayX, "0")
        GregorianStringJS = DateString + EraString
    
    Case 2
        DateString = Format(YearX, "0")
        GregorianStringJS = DateString + EraString
    
    Case 3
        DateString = Format(MonthName(MonthX), "\ &&&&&&&&&") + _
            Format(DayX, "\ 0\,") + Format(YearX, "\ 0")
        TimeString = Format(HourX, "00\:") + _
            Format(MinuteX, "00\:") + Format(SecondX, "00\,")
        GregorianStringJS = TimeString + DateString + EraString

    Case 4
        DateString = Format(MonthName(MonthX), "&&&&&&&&&") + _
            Format(DayX, "\ 0\,") + Format(YearX, "\ 0")
        GregorianStringJS = DateString + EraString
    
    Case Else
        Err.Clear
        Err.Raise xlErrValue
End Select

End Function

' ----------------------------------------------------------------------
' Cavernian/Atrian conversion routines.
' ----------------------------------------------------------------------

Function AtrianSerialCD(Hahr As Long, VaileeX As Variant, _
    Yahr As Integer, Optional Gahrtahvo As Integer = 0, _
    Optional Tahvo As Integer = 0, Optional Gorahn As Integer = 0, _
    Optional Prorahn As Integer = 0) As Double
    
' ----------------------------------------------------------------------
' Convert a Cavernian date/time to an Atrian serial number (ASN), which
' is the number of yahrtee and fractions relative to time 0:00:00:00
' on Leefo 1 (the D'ni New Year) of a selected hahr. (The choice of hahr
' is built in as the constant "Base_Hahr" in the declarations section
' of this module).
'
' The vailee (month) of the date can be provided as either a number or
' a name. If the optional time is included, it will be expressed as the
' fractional part of the ASN. If not provided, the time is assumed to
' be at the start of the day (0:00:00:00).
'
' The date conversion is much simpler than converting Gregorian dates
' to Julian serial numbers, because D'ni months (vailee) all have 29
' days (yahrtee), and all years (hahrtee) are of equal length.
'
' The algorithm works with any convenient base hahr, from the Cavernian
' year zero onward. It can technically handle dates in the proleptic
' Cavernian calendar, prior to the arrival on Earth of Ri'Neref and his
' followers.  However, this is a little pointless, since we have no way
' to correlate such dates to dates in the calendar used by the Ronay
' on Garternay, nor do we have any information on that calendar, such
' as the length of the year.
' ----------------------------------------------------------------------

Dim HahrYahrtee As Long, VaileeYahrtee As Integer, AtrianYahr As Long
Dim GahrtahvoPro As Long, TahvoPro As Integer, GorahnPro As Integer
Dim TotalPro As Long, YahrFraction As Double, Vailee As Integer

Err.Clear   ' Clear out the Error object, just in case we need it.

' Determine whether the input vailee is a number or a name. If a name,
' convert it to a number. The vailee will be 0 if there is no match or
' if the variable type isn't readily converted to integer.

Select Case VarType(VaileeX)
    Case vbInteger, vbLong, vbSingle, vbDouble
        Vailee = CInt(VaileeX)
    
    Case vbString
        Vailee = VaileeNumber(VaileeX)
        
    Case Else
        Vailee = 0
End Select

' Ensure that the vailee and yahr are within valid limits.

If ((Vailee < 1 Or Vailee > Vaileetee_per_Hahr) Or _
    (Yahr < 1 Or Yahr > Yahrtee_per_Vailee)) Then Err.Raise xlErrValue

' Determine the number of yahrtee accounted for by full hahr that
' have elapsed since the base hahr.

HahrYahrtee = (Hahr - Base_Hahr) * CLng(Yahrtee_per_Hahr)

' Determine the number of yahrtee accounted for by vaileetee previous
' to the current vailee in the current hahr.

VaileeYahrtee = (Vailee - 1) * Yahrtee_per_Vailee
    
' Sum the yahr counts, including the current yahr of the current
' vailee, to get the number of whole yahrtee elapsed.

AtrianYahr = CLng(Yahr) + CLng(VaileeYahrtee) + HahrYahrtee

' Ensure that the time components are within valid limits.

If ((Gahrtahvo < 0 Or Gahrtahvo >= Gahrtahvotee_per_Yahr) Or _
    (Tahvo < 0 Or Tahvo >= Tahvotee_per_Gahrtahvo) Or _
    (Gorahn < 0 Or Gorahn >= Gorahntee_per_Tahvo) Or _
    (Prorahn < 0 Or Prorahn >= Prorahntee_per_Gorahn)) Then _
    Err.Raise xlErrValue

' If a time is provided, convert it to a total number of prorahntee
' since the start of the yahr, and express it as a fraction of a full
' yahr.

GahrtahvoPro = CLng(Gahrtahvo) * CLng(Prorahntee_per_Gahrtahvo)
TahvoPro = Tahvo * Prorahntee_per_Tahvo
GorahnPro = Gorahn * Prorahntee_per_Gorahn

TotalPro = GahrtahvoPro + CLng(TahvoPro) + CLng(GorahnPro) + _
    CLng(Prorahn)

YahrFraction = CDbl(TotalPro) / CDbl(Prorahntee_per_Yahr)

' Sum the day and time components and return the result.

AtrianSerialCD = CDbl(AtrianYahr) + YahrFraction

End Function

Sub CavernianAS(AtrianSerial As Double, Hahr As Long, Vailee As Integer, _
    Yahr As Integer, Optional Gahrtahvo As Integer = 0, _
    Optional Tahvo As Integer = 0, Optional Gorahn As Integer = 0, _
    Optional Prorahn As Integer = 0)

' ----------------------------------------------------------------------
' Convert an Atrian serial number (ASN) to a Cavernian date/time. The
' ASN is the number of yahrtee and fractions that have elapsed since
' time 0:00:00:00 on Leefo 1 of a selected base hahr. Any fractional
' part of the ASN will be converted to a time of yahr.
'
' The conversion is much simpler than converting Julian serial numbers
' to Gregorian dates, because D'ni months (vailee) all have 29 days
' (yahrtee), and all years (hahrtee) are of equal length.
'
' The algorithm can technically handle dates in the proleptic Cavernian
' calendar, prior to the arrival on Earth of Ri'Neref and his followers.
' However, this is a little pointless, since we have no way to correlate
' such dates to dates in the calendar used by the Ronay on Garternay,
' nor do we have any information on that calendar, such as the length
' of the year.
' ----------------------------------------------------------------------

Dim AtrianYahr As Long, RemainingYahr As Long, CorrectedYahr As Double
Dim Hahrtee As Long, Vaileetee As Integer, YahrFraction As Double
Dim TotalPro As Long

' Extract the integer part of the Atrian serial number, which is the
' Atrian yahr number. Because the last yahr in the span is always only
' a partial yahr, a small constant amount must be subtracted to ensure
' that the final calculation is off by less than one yahr. Then the INT
' function can eliminate the approximation error. A quarter of a yahr
' is a convenient value for this purpose.

AtrianYahr = Int(AtrianSerial)
CorrectedYahr = CDbl(AtrianYahr) - QuarterYahr

' Add the number of full hahrtee in the span to the base hahr to get
' the hahr for the date. Subtract the number of yahrtee in the full
' hahrtee to determine the number of yahrtee left to account for.

Hahrtee = Int(CorrectedYahr / CDbl(Yahrtee_per_Hahr))
Hahr = Base_Hahr + Hahrtee

RemainingYahr = AtrianYahr - (Hahrtee * CLng(Yahrtee_per_Hahr))
CorrectedYahr = CDbl(RemainingYahr) - QuarterYahr

' Determine the number of full vaileetee in the remainder and add 1
' to get the current vailee.

Vaileetee = Int(CorrectedYahr / CDbl(Yahrtee_per_Vailee))
Vailee = Vaileetee + 1

' Subtract the number of yahrtee in the previous vaileetee to get
' the current yahr of the vailee.
     
Yahr = RemainingYahr - (Vaileetee * Yahrtee_per_Vailee)

' Extract the fractional part of the Atrian serial number, which is
' time of yahr expressed as the fraction of the total number of
' prorahntee in a yahr. Convert it to prorahntee, then extract the
' gahrtahvo, tahvo, gorahn, and prorahn.  Because of possible
' precision errors in the binary representation of decimal numbers,
' the value is explicitly rounded to whole prorahntee, and then
' checked to be sure it didn't round up to a whole yahr.

YahrFraction = AtrianSerial - AtrianYahr

If YahrFraction <> 0 Then
    TotalPro = Round((YahrFraction * Prorahntee_per_Yahr), 0)
    
    If TotalPro >= Prorahntee_per_Yahr Then _
        TotalPro = Prorahntee_per_Yahr - 1

    Gahrtahvo = Fix(TotalPro / CLng(Prorahntee_per_Gahrtahvo))
    TotalPro = TotalPro - (CLng(Gahrtahvo) * _
        CLng(Prorahntee_per_Gahrtahvo))

    Tahvo = Fix(TotalPro / Prorahntee_per_Tahvo)
    TotalPro = TotalPro - (Tahvo * Prorahntee_per_Tahvo)

    Gorahn = Fix(TotalPro / Prorahntee_per_Gorahn)

    Prorahn = TotalPro - (Gorahn * Prorahntee_per_Gorahn)
Else
    Gahrtahvo = 0
    Tahvo = 0
    Gorahn = 0
    Prorahn = 0
End If

End Sub

Function CavernianStringAS(AtrianSerial As Double, _
    Optional FormatOption As Byte) As String

' ----------------------------------------------------------------------
' Convert an Atrian serial number to a Cavernian date/time and format
' the result as a string.  This is an interface to the CavernianAS
' subroutine.
'
' The format option code determines the content of the string:
'
'   0 = Compact date/time (default) = "h.v.y G:tt:gg:pp"
'   1 = Compact date only = "h.v.y"
'   2 = Hahr only = "h"
'   3 = Long date/time string = "G:tt:gg:pp, vaileename y, h"
'   4 = Long date only = "vaileename y, h"
'
' All strings are suffixed with the era designation. Leading zeros are
' omitted from hahr, vailee, and yahr values. Vailee names in long
' dates are mixed case.
' ----------------------------------------------------------------------

Dim Hahr As Long, Vailee As Integer, Yahr As Integer
Dim Gahrtahvo As Integer, Tahvo As Integer, Gorahn As Integer
Dim Prorahn As Integer
Dim DateString As String, TimeString As String

' Call subroutine to perform the actual conversion.

Call CavernianAS(AtrianSerial, Hahr, Vailee, Yahr, Gahrtahvo, Tahvo, _
    Gorahn, Prorahn)

' Build date and time strings, according to format option.

Select Case FormatOption
    Case 0
        DateString = Format(Hahr, "0\.") + Format(Vailee, "0\.") _
            + Format(Yahr, "0")
        TimeString = Format(Gahrtahvo, "\ 0\:") + _
            Format(Tahvo, "00\:") + Format(Gorahn, "00\:") + _
            Format(Prorahn, "00")
        CavernianStringAS = DateString + TimeString + " DE"

    Case 1
        DateString = Format(Hahr, "0\.") + Format(Vailee, "0\.") _
            + Format(Yahr, "0")
        CavernianStringAS = DateString + " DE"
    
    Case 2
        DateString = Format(Hahr, "0")
        CavernianStringAS = DateString + " DE"
    
    Case 3
        DateString = Format(VaileeName(Vailee), "\ &&&&&&&&&") + _
            Format(Yahr, "\ 0\,") + Format(Hahr, "\ 0")
        TimeString = Format(Gahrtahvo, "0\:") + _
            Format(Tahvo, "00\:") + Format(Gorahn, "00\:") + _
            Format(Prorahn, "00\,")
        CavernianStringAS = TimeString + DateString + " DE"

    Case 4
        DateString = Format(VaileeName(Vailee), "&&&&&&&&&") + _
            Format(Yahr, "\ 0\,") + Format(Hahr, "\ 0")
        CavernianStringAS = DateString + " DE"
    
    Case Else
        Err.Clear
        Err.Raise xlErrValue
End Select

End Function

' ----------------------------------------------------------------------
' Julian/Atrian conversion routines.
' ----------------------------------------------------------------------

Function JulianSerialAS(AtrianSerial As Double) As Double

' ----------------------------------------------------------------------
' Convert an Atrian serial number (ASN) to a Julian serial number (JSN).
' ----------------------------------------------------------------------

Dim AtrianDiff As Double, JulianDiff As Double
Dim DayNumber As Double, DayFraction As Double, TotalSecs As Double

' Subtract the Atrian serial number of the base date from the input
' ASN to get a deviation expressed in yahrtee and fractions. Re-express
' the deviation as days and fractions on the Gregorian calendar.

AtrianDiff = AtrianSerial - Base_ASN

JulianDiff = AtrianDiff * Days_per_Yahr

' Split the converted deviation into integer and fractional parts.
' The fractional part must be an even number of seconds, so adjust it
' for any errors in precision by rounding to the nearest second.

DayNumber = Int(JulianDiff)
DayFraction = JulianDiff - DayNumber

If DayFraction <> 0 Then
    TotalSecs = DayFraction * Seconds_per_Day
    DayFraction = Round(TotalSecs, 0) / Seconds_per_Day
    JulianDiff = DayNumber + DayFraction
End If

' Add the converted deviation to the Julian serial number of the base.

JulianSerialAS = Base_JSN + JulianDiff

End Function

Function AtrianSerialJS(JulianSerial As Double) As Double

' ----------------------------------------------------------------------
' Convert a Julian serial number (JSN) to an Atrian serial number (ASN).
' ----------------------------------------------------------------------

Dim JulianDiff As Double, AtrianDiff As Double
Dim YahrNumber As Double, YahrFraction As Double, TotalPro As Double

' Subtract the Julian serial number of the base date from the input
' JSN to get a deviation expressed in days and fractions. Re-express
' the deviation as yahrtee and fractions on the Cavernian calendar.

JulianDiff = JulianSerial - Base_JSN

AtrianDiff = JulianDiff * Yahrtee_per_Day

' Split the converted deviation into integer and fractional parts.
' The fractional part must be an even number of prorahntee, so adjust
' it for any errors in precision by rounding upward to the nearest
' prorahn.

YahrNumber = Int(AtrianDiff)
YahrFraction = AtrianDiff - YahrNumber

If YahrFraction <> 0 Then
    TotalPro = YahrFraction * Prorahntee_per_Yahr
    YahrFraction = Round(TotalPro, 0) / Prorahntee_per_Yahr
    AtrianDiff = YahrNumber + YahrFraction
End If

' Add the converted deviation to the Atrian serial number of the base.

AtrianSerialJS = Base_ASN + AtrianDiff

End Function

' ----------------------------------------------------------------------
' Cavernian/Gregorian conversion wrapper functions.
' ----------------------------------------------------------------------

Function GregorianStringCD(Hahr As Long, VaileeX As Variant, _
    Yahr As Integer, Optional Gahrtahvo As Integer = 0, _
    Optional Tahvo As Integer = 0, Optional Gorahn As Integer = 0, _
    Optional Prorahn As Integer = 0, _
    Optional FormatOption As Byte = 0) As String

' ----------------------------------------------------------------------
' Convert a Cavernian date/time to a Gregorian date/time and format
' the result as a string. The input vailee may be either a number or
' a name.
'
' This is basically a do-it-all wrapper for other routines, so a full
' conversion from Cavernian input to Gregorian display output can be
' done with a single formula in a cell, rather than using intermediate
' cells or complex nested function calls.
'
' The format option code determines the content of the string:
'
'   0 = Compact date/time (default) = "y.m.d hh:mm:ss"
'   1 = Compact date only = "y.m.d"
'   2 = Year only = "y"
'   3 = Long date/time string = "hh:mm:ss, monthname d, y"
'   4 = Long date only = "monthname d, y"
'
' All strings are suffixed with the era designation. Leading zeros are
' omitted from year, month, and day values. Month names in long dates
' are mixed case.
' ----------------------------------------------------------------------

Dim AtrianSerial As Double, JulianSerial As Double

' Convert the Cavernian date/time to an Atrian serial number, from
' Atrian serial number to a Julian serial number, and from Julian
' serial number to Gregorian date/time string.

AtrianSerial = AtrianSerialCD(Hahr, VaileeX, Yahr, Gahrtahvo, Tahvo, _
    Gorahn, Prorahn)

JulianSerial = JulianSerialAS(AtrianSerial)

GregorianStringCD = GregorianStringJS(JulianSerial, FormatOption)

End Function

Function CavernianStringGD(IsCommonEra As Boolean, _
    YearX As Long, MonthX As Variant, DayX As Integer, _
    Optional HourX As Integer = 0, Optional MinuteX As Integer = 0, _
    Optional SecondX As Integer = 0, _
    Optional FormatOption As Byte = 0) As String

' ----------------------------------------------------------------------
' Convert a Gregorian date/time to a Cavernian date/time and format
' the result as a string. The input month may be either a number or
' a name.
'
' This is basically a do-it-all wrapper for other routines, so a full
' conversion from Gregorian input to Cavernian display output can be
' done with a single formula in a cell, rather than using intermediate
' cells or complex nested function calls.
'
' The format option code determines the content of the string:
'
'   0 = Compact date/time (default) = "h.v.y G:tt:gg:pp"
'   1 = Compact date only = "h.v.y"
'   2 = Hahr only = "h"
'   3 = Long date/time string = "G:tt:gg:pp, vaileename y, h"
'   4 = Long date only = "vaileename y, h"
'
' All strings are suffixed with the era designation. Leading zeros are
' omitted from hahr, vailee, and yahr values. Vailee names in long
' dates are mixed case.
' ----------------------------------------------------------------------

Dim AtrianSerial As Double, JulianSerial As Double

' Convert the Gregorian date/time to a Julian serial number, from
' Julian serial number to an Atrian serial number, and from Atrian
' serial number to Cavernian date/time string.

JulianSerial = JulianSerialGD(IsCommonEra, YearX, MonthX, DayX, _
    HourX, MinuteX, SecondX)

AtrianSerial = AtrianSerialJS(JulianSerial)

CavernianStringGD = CavernianStringAS(AtrianSerial, FormatOption)

End Function