A decade or so ago I had to write code to spell numbers for checks for US banks. Here's what I have; I apologize for it being in a terrible language:
Code:
Function SpellNumber(ByVal MyNumber)
Dim Sign, Dollars, Cents, Hundreds
Dim DecimalPlace, Count
Dim Place(9) As String
Place(2) = " Thousand"
Place(3) = " Million"
Place(4) = " Billion"
Place(5) = " Trillion" ' String representation of amount
If MyNumber < 0 Then
Sign = "Negative "
MyNumber = MyNumber*-1
Else
Sign = ""
End If
MyNumber = Trim(Str(MyNumber)) ' Position of decimal place 0 if none
DecimalPlace = InStr(MyNumber, ".")
'Convert cents and set MyNumber to dollar amount
If DecimalPlace > 0 Then
Cents = GetTens(Left(Mid(MyNumber, DecimalPlace + 1) & "00", 2))
MyNumber = Trim(Left(MyNumber, DecimalPlace - 1))
End If
Count = 1
Do While MyNumber <> ""
Hundreds = GetHundreds(Right(MyNumber, 3))
If Hundreds <> "" Then
If Dollars <> "" Then
Dollars = ", " & Dollars
End If
Dollars = Hundreds & Place(Count) & Dollars
End If
If Len(MyNumber) > 3 Then
MyNumber = Left(MyNumber, Len(MyNumber) - 3)
Else
MyNumber = ""
End If
Count = Count + 1
Loop
Select Case Dollars
Case ""
Dollars = "No Dollars"
Case "One"
Dollars = "One Dollar"
Case Else
Dollars = Dollars & " Dollars"
End Select
Select Case Cents
Case ""
Cents = " and No Cents"
Case "One"
Cents = " and One Cent"
Case Else
Cents = " and " & Cents & " Cents"
End Select
SpellNumber = Sign & Dollars & Cents
End Function