Public Function CurrencyText(ByVal CurrencyValue As Double) As String
Dim Cents As Integer
Dim Dollars As String
Dim Units(9) As String
Dim Teens(9) As String
Dim Tens(9) As String
Teens(0) = "Ten" : Tens(0) = ""
Units(1) = "One" : Teens(1) = "Eleven" : Tens(1) = "Ten"
Units(2) = "Two" : Teens(2) = "Twelve" : Tens(2) = "Twenty"
Units(3) = "Three" : Teens(3) = "Thirteen" : Tens(3) = "Thirty"
Units(4) = "Four" : Teens(4) = "Fourteen" : Tens(4) = "Forty"
Units(5) = "Five" : Teens(5) = "Fifteen" : Tens(5) = "Fifty"
Units(6) = "Six" : Teens(6) = "Sixteen" : Tens(6) = "Sixty"
Units(7) = "Seven" : Teens(7) = "Seventeen" : Tens(7) = "Seventy"
Units(8) = "Eight" : Teens(8) = "Eighteen" : Tens(8) = "Eighty"
Units(9) = "Nine" : Teens(9) = "Nineteen" : Tens(9) = "Ninety"
Cents = (CurrencyValue - Int(CurrencyValue)) * 100
Dollars = Format(Int(CurrencyValue), "000000000")
Select Case Cents
Case 0
CurrencyText = "and 00/100 Dollars"
Case Else
CurrencyText = "and " & Format(Cents, " 00") & "/100 Dollars"
End Select
Select Case Mid(Dollars, Len(Dollars) - 1, 1) 'tens digit
Case "1" 'last two digits are teens
CurrencyText = Teens(Val(Right(Dollars, 1))) & " &" & CurrencyText
Case Else
CurrencyText = Tens(Val(Mid(Dollars, Len(Dollars) - 1, 1))) & " " & _
Units(Val(Right(Dollars, 1))) & " &" & CurrencyText
End Select
If Mid(Dollars, Len(Dollars) - 2, 1) <> "0" Then 'hundreds digit
CurrencyText = Units(Val(Mid(Dollars, Len(Dollars) - 2, 1))) & " Hundred " & CurrencyText
End If
Dollars = Left(Dollars, Len(Dollars) - 3) 'trim off hundreds,tens, & units
If Right(Dollars, 3) <> "000" Then 'no thousands
Select Case Mid(Dollars, Len(Dollars) - 1, 1) 'ten thousand digit
Case "1" 'last two digits are teens
CurrencyText = Teens(Val(Right(Dollars, 1))) & " Thousand " & CurrencyText
Case Else
CurrencyText = Tens(Val(Mid(Dollars, Len(Dollars) - 1, 1))) & " " & _
Units(Val(Right(Dollars, 1))) & " Thousand " & CurrencyText
End Select
If Mid(Dollars, Len(Dollars) - 2, 1) <> "0" Then 'thousands digit
CurrencyText = Units(Val(Mid(Dollars, Len(Dollars) - 2, 1))) & " Hundred " & CurrencyText
End If
End If
Dollars = Left(Dollars, Len(Dollars) - 3) 'trim off thousands...leave millions
If Right(Dollars, 3) <> "000" Then 'no millions
Select Case Mid(Dollars, Len(Dollars) - 1, 1) 'ten million digit
Case "1" 'last two digits are teens
CurrencyText = Teens(Val(Right(Dollars, 1))) & " Million " & CurrencyText
Case Else
CurrencyText = Tens(Val(Mid(Dollars, Len(Dollars) - 1, 1))) & " " & _
Units(Val(Right(Dollars, 1))) & " Million " & CurrencyText
End Select
If Mid(Dollars, Len(Dollars) - 2, 1) <> "0" Then 'millions digit
CurrencyText = Units(Val(Mid(Dollars, Len(Dollars) - 2, 1))) & " Hundred " & CurrencyText
End If
End If
End Function
|