Option Compare Database
Option Explicit


Function ConvertCurrencyToEnglish(ByVal MyNumber)
'test: ConvertCurrencyToEnglish(1234.56)
   Dim Temp
   Dim Dollars, Cents
   Dim DecimalPlace, Count

   ReDim Place(9) As String
   Place(2) = " Thousand "
   Place(3) = " Million "
   Place(4) = " Billion "
   Place(5) = " Trillion "

   ' Convert MyNumber to a string, trimming extra spaces.
   MyNumber = Trim(Str(MyNumber))

   ' Find decimal place.
   DecimalPlace = InStr(MyNumber, ".")

   ' If we find decimal place...
   If DecimalPlace > 0 Then
      ' Convert cents
      Temp = Left(Mid(MyNumber, DecimalPlace + 1) & "00", 2)
      Cents = ConvertTens(Temp)

      ' Strip off cents from remainder to convert.
      MyNumber = Trim(Left(MyNumber, DecimalPlace - 1))
   End If

   Count = 1
   Do While MyNumber <> ""
      ' Convert last 3 digits of MyNumber to English dollars.
      Temp = ConvertHundreds(Right(MyNumber, 3))
      If Temp <> "" Then Dollars = Temp & Place(Count) & Dollars
      If Len(MyNumber) > 3 Then
         ' Remove last 3 converted digits from MyNumber.
         MyNumber = Left(MyNumber, Len(MyNumber) - 3)
      Else
         MyNumber = ""
      End If
      Count = Count + 1
   Loop

   ' Clean up dollars.
   Select Case Dollars
      Case ""
         Dollars = "No Dollars"
      Case "One"
         Dollars = "One Dollar"
      Case Else
         Dollars = Dollars & " Dollars"
   End Select

   ' Clean up cents.
   Select Case Cents
      Case ""
         Cents = " And No Cents"
      Case "One"
         Cents = " And One Cent"
      Case Else
         Cents = " And " & Cents & " Cents"
   End Select

   ConvertCurrencyToEnglish = Dollars & Cents
End Function


Private Function ConvertDigit(ByVal MyDigit)
   Select Case Val(MyDigit)
      Case 1: ConvertDigit = "One"
      Case 2: ConvertDigit = "Two"
      Case 3: ConvertDigit = "Three"
      Case 4: ConvertDigit = "Four"
      Case 5: ConvertDigit = "Five"
      Case 6: ConvertDigit = "Six"
      Case 7: ConvertDigit = "Seven"
      Case 8: ConvertDigit = "Eight"
      Case 9: ConvertDigit = "Nine"
      Case Else: ConvertDigit = ""
   End Select
End Function


Private Function ConvertHundreds(ByVal MyNumber)
   Dim Result As String

   ' Exit if there is nothing to convert.
   If Val(MyNumber) = 0 Then Exit Function

   ' Append leading zeros to number.
   MyNumber = Right("000" & MyNumber, 3)

   ' Do we have a hundreds place digit to convert?
   If Left(MyNumber, 1) <> "0" Then
      Result = ConvertDigit(Left(MyNumber, 1)) & " Hundred "
   End If

   ' Do we have a tens place digit to convert?
   If Mid(MyNumber, 2, 1) <> "0" Then
      Result = Result & ConvertTens(Mid(MyNumber, 2))
   Else
      ' If not, then convert the ones place digit.
      Result = Result & ConvertDigit(Mid(MyNumber, 3))
   End If

   ConvertHundreds = Trim(Result)
End Function


Private Function ConvertTens(ByVal MyTens)
   Dim Result As String

   ' Is value between 10 and 19?
   If Val(Left(MyTens, 1)) = 1 Then
      Select Case Val(MyTens)
         Case 10: Result = "Ten"
         Case 11: Result = "Eleven"
         Case 12: Result = "Twelve"
         Case 13: Result = "Thirteen"
         Case 14: Result = "Fourteen"
         Case 15: Result = "Fifteen"
         Case 16: Result = "Sixteen"
         Case 17: Result = "Seventeen"
         Case 18: Result = "Eighteen"
         Case 19: Result = "Nineteen"
         Case Else
      End Select
   Else
      ' .. otherwise it's between 20 and 99.
      Select Case Val(Left(MyTens, 1))
         Case 2: Result = "Twenty "
         Case 3: Result = "Thirty "
         Case 4: Result = "Forty "
         Case 5: Result = "Fifty "
         Case 6: Result = "Sixty "
         Case 7: Result = "Seventy "
         Case 8: Result = "Eighty "
         Case 9: Result = "Ninety "
         Case Else
      End Select

      ' Convert ones place digit.
      Result = Result & ConvertDigit(Right(MyTens, 1))
   End If

   ConvertTens = Result
End Function


Public Function DateToWords(varDate As Variant)
'Purpose  : Convert date to English.
'DateTime : 6/20/2006 11:36
'Author   : Bill Mosca
'Calls    : ConvertCurrencyToEnglish for year portion.
    Dim intDay As Integer
    Dim strDay As String
    Dim strMonth As String
    Dim strYear As String
    Dim intYear As Long
    
    'Leave if no date passed.
    If IsNull(varDate) Then Exit Function
    
    intDay = Day(varDate)
    
    Select Case intDay
        Case 1
            strDay = "First"
        Case 2
            strDay = "Second"
        Case 3
            strDay = "Third"
        Case 4
            strDay = "Fourth"
        Case 5
            strDay = "Fifth"
        Case 6
            strDay = "Sixth"
        Case 7
            strDay = "Seventh"
        Case 8
            strDay = "Eighth"
        Case 9
            strDay = "Ninth"
        Case 10
            strDay = "Tenth"
        Case 11
            strDay = "Eleventh"
        Case 12
            strDay = "Twelfth"
        Case 13
            strDay = "Thirteenth"
        Case 14
            strDay = "Fourteenth"
        Case 15
            strDay = "Fifteenth"
        Case 16
            strDay = "Sixteenth"
        Case 17
            strDay = "Seventeenth"
        Case 18
            strDay = "Eighteenth"
        Case 19
            strDay = "Nineteenth"
        Case 20
            strDay = "Twentieth"
        Case 21
            strDay = "Twenty First"
        Case 22
            strDay = "Twenty Second"
        Case 23
            strDay = "Twenty Third"
        Case 24
            strDay = "Twenty Fourth"
        Case 25
            strDay = "Twenty Fifth"
        Case 26
            strDay = "Twenty Sixth"
        Case 27
            strDay = "Twenty Seventh"
        Case 28
            strDay = "Twenty Eighth"
        Case 29
            strDay = "Twenty Ninth"
        Case 30
            strDay = "Thirtieth"
        Case 31
            strDay = "Thirty First"
    End Select
    
    strMonth = Format(varDate, "mmmm")
    intYear = Year(varDate)
    strYear = ConvertCurrencyToEnglish(intYear)
    
    'Remove Dollars And No Cents from strYear
    strYear = Replace(strYear, " Dollars And No Cents", "")
    
    DateToWords = strDay & " day of " & strMonth & " " & strYear
    
End Function