' Copyright 1993 Stephen Schmidt
' All Rights Reserved
'
' USERS OF THIS PROGRAM MUST ACCEPT THIS DISCLAIMER OF WARRANTY:  "THIS PROGRAM
' IS SUPPLIED AS IS.  THE AUTHOR DISCLAIMS ALL WARRANTIES, EXPRESSED OR IMPLIED,
' INCLUDING, WITHOUT LIMITATION, THE WARRANTIES OF MERCHANTABILITY AND OF
' FITNESS FOR ANY PURPOSE.  THE AUTHOR ASSUMES NO LIABILITY FOR DAMAGES, DIRECT
' OR CONSEQUENTIAL, WHICH MAY RESULT FROM THE USE OF THIS PROGRAM."
'
' Copyrighted freeware--you can do anything you want this module except remove
' the disclaimer or any of the copyright notices.  Thanks for your cooperation.
'
' Stephen Schmidt, Internet: 73200.3207@compuserve.com
'
'
' To use these functions, load them into a Module within your database.
' To test them, Open the Module containing them, display the Immediate
'    Window, and type "DollarStringTest" (without the quotes, followed
'    by {Enter}).
'
Option Compare Database   'Use database order for string comparisons
Option Explicit

Function DollarString (ByVal Value As Variant) As String
    ' Copyright 1993 Stephen Schmidt
    ' All Rights Reserved

    ' Accepts a number representing currency, and returns the value written in words.
    ' For example:
    '    DollarString(34.23) = "Thirty-four and 23/100 Dollars"
    ' or
    '    DollarString(34.23) = "Thirty-four Dollars and Twenty-three Cents"

    ' note: Change this constant according to your preference.
    '    True:  "... Dollars and Fifty-six Cents"
    '    False: "... and 56/100 Dollars"
    Const SpellOutTheCents = False

    ' Handles cases where interpretation of the passed Value is impossible, and other unforseen
    ' errors.  Null is returned in case of errors.
    On Error GoTo DollarStringEnd

    Static NM(0 To 5) As String
    If NM(1) <> "Thousand" Then
        NM(0) = ""
        NM(1) = " Thousand"
        NM(2) = " Million"
        NM(3) = " Billion"
        NM(4) = " Trillion"
        NM(5) = " Quadrillion"
    End If
    
    ' The On Error statement handles the case where the Variant argument
    ' can't be converted into a double type value.
    Dim Dollars As Double
    Dollars = CDbl(Fix(Abs(Value)))

    Dim Cents As Integer
    Cents = (Abs(Value) - Dollars) * 100

    Dim Result As String
    Dim CurValue As Double

    If Dollars = 0 Then
        If SpellOutTheCents Then Result = "Zero "
    ElseIf Dollars >= 1100# And Dollars < 2000# Then
        ' Handle numbers in this range as a special case--write-out something like "Twelve Hundred ...."
        If Dollars Mod 100 <> 0 Then Result = NumberToString(Dollars Mod 100) + " " + Result
        Result = NumberToString(Dollars \ 100) + " Hundred " + Result
        Dollars = Dollars Mod 100
    ElseIf Dollars > 0 Then
        ' Otherwise, examine every set of three digits, starting with the least significant.
        Dim KSets As Integer
        For KSets = 0 To (Fix(LogN(Dollars, 10)) \ 3)
            CurValue = Dollars - Int(Dollars / 1000#) * 1000#
            Dollars = Int(Dollars / 1000#)
            If CurValue <> 0 Then Result = NumberToString(CurValue) + NM(KSets) + " " + Result
        Next KSets
    End If

    If Not SpellOutTheCents And Cents <> 0 Then
        ' Add "and xx/100" (cents), if appropriate.
        If Fix(Value) <> 0 Then Result = Result + "and "
        Result = Result + Format$(Cents, "0") + "/100 "
    End If
    
    If SpellOutTheCents And Fix(Abs(Value)) = 1 Or Abs(Value) = 1 Then
        Result = Result + "Dollar"
    Else
        Result = Result + "Dollars"
    End If

    If SpellOutTheCents And Cents <> 0 Then
        Result = Result + " and " + NumberToString(Cents)
        If Cents = 1 Then
            Result = Result + " Cent"
        Else
            Result = Result + " Cents"
        End If
    End If

    ' Prefix string with the word "Negative", if appropriate.
    If Value < 0 Then Result = "Negative " + Result

    DollarString = Result

DollarStringEnd:
    Exit Function
End Function

Private Sub DollarStringTest ()
    ' Copyright 1993 Stephen Schmidt
    ' All Rights Reserved

    ' Tests the DollarString function by writing a bunch of
    ' sample amounts into the Immediate Window.

    DollarStringTestOne -123456789123456.78@
    DollarStringTestOne -12345678912345.67@
    DollarStringTestOne -1234567891234.56@
    DollarStringTestOne -123456789123.45@
    DollarStringTestOne -12345678912.34@
    DollarStringTestOne -1234567891.23@
    DollarStringTestOne -123456789.12@
    DollarStringTestOne -12345678.91@
    DollarStringTestOne -1234567.89@
    DollarStringTestOne -123456.78@
    DollarStringTestOne -12345.67@
    DollarStringTestOne -1234.56@
    DollarStringTestOne -123.45@
    DollarStringTestOne -12.34@
    DollarStringTestOne -1.23@
    DollarStringTestOne -.12@
    DollarStringTestOne -.01@
    
    DollarStringTestOne .01@
    DollarStringTestOne .12@
    DollarStringTestOne 1.23@
    DollarStringTestOne 12.34@
    DollarStringTestOne 123.45@
    DollarStringTestOne 1234.56@
    DollarStringTestOne 12345.67@
    DollarStringTestOne 123456.78@
    DollarStringTestOne 1234567.89@
    DollarStringTestOne 12345678.91@
    DollarStringTestOne 123456789.12@
    DollarStringTestOne 1234567891.23@
    DollarStringTestOne 12345678912.34@
    DollarStringTestOne 123456789123.45@
    DollarStringTestOne 1234567891234.56@
    DollarStringTestOne 12345678912345.67@
    DollarStringTestOne 123456789123456.78@

    DollarStringTestOne 1@
    DollarStringTestOne 10@
    DollarStringTestOne 100@
    DollarStringTestOne 1000@
    DollarStringTestOne 10000@
    DollarStringTestOne 100000@
    DollarStringTestOne 1000000@
    DollarStringTestOne 10000000@
    DollarStringTestOne 100000000@
    DollarStringTestOne 1000000000@
    DollarStringTestOne 10000000000@
    DollarStringTestOne 100000000000@
    DollarStringTestOne 1000000000000@
    DollarStringTestOne 10000000000000@
    DollarStringTestOne 100000000000000@
End Sub

Private Sub DollarStringTestOne (Value As Currency)
    ' Copyright 1993 Stephen Schmidt
    ' All Rights Reserved

    Debug.Print " " + Format$(Value, "####,###,###,###,##0.0000") + ": " + DollarString(Value)
End Sub

Private Function LogN (X As Variant, N As Variant) As Variant
    ' Logarithm

    LogN = Log(X) / Log(N)
End Function

Function NumberToString (ByVal Value As Variant) As String
    ' Copyright 1993 Stephen Schmidt
    ' All Rights Reserved

    ' Converts a number between 0 and 999 into words.

    Static NW(0 To 20) As String
    Static NT(2 To 9) As String

    If NW(1) <> "One" Then
        NW(0) = ""
        NW(1) = "One"
        NW(2) = "Two"
        NW(3) = "Three"
        NW(4) = "Four"
        NW(5) = "Five"
        NW(6) = "Six"
        NW(7) = "Seven"
        NW(8) = "Eight"
        NW(9) = "Nine"
        NW(10) = "Ten"
        NW(11) = "Eleven"
        NW(12) = "Twelve"
        NW(13) = "Thirteen"
        NW(14) = "Fourteen"
        NW(15) = "Fifteen"
        NW(16) = "Sixteen"
        NW(17) = "Seventeen"
        NW(18) = "Eighteen"
        NW(19) = "Nineteen"
        NW(20) = "Twenty"
    
        NT(2) = "Twenty"
        NT(3) = "Thirty"
        NT(4) = "Forty"
        NT(5) = "Fifty"
        NT(6) = "Sixty"
        NT(7) = "Seventy"
        NT(8) = "Eighty"
        NT(9) = "Ninety"
    End If

    Dim Result As String
    
    ' Turn the most significant digit into words.
    If Value >= 100 Then
        Result = NW(Value \ 100) + " Hundred"
        Value = Value Mod 100
        If Value <> 0 Then Result = Result + " "
    End If

    ' Turn the two least significant digits into words.
    Select Case Value
        Case 1 To 20
            Result = Result + NW(Value)
        Case 21 To 99
            Result = Result + NT(Value \ 10)
            Value = Value Mod 10
            If Value <> 0 Then Result = Result + "-" + LCase$(NW(Value))
    End Select

    NumberToString = Result
End Function

