Function ConvertToWords(ByVal MyNumber As Double) As String
Dim Temp As String
Dim Ones As Variant, Teens As Variant, Tens As Variant
Ones = Array("", "One", "Two", "Three", "Four", "Five", "Six", "Seven", "Eight", "Nine")
Teens = Array("Ten", "Eleven", "Twelve", "Thirteen", "Fourteen", "Fifteen", "Sixteen", "Seventeen", "Eighteen", "Nineteen")
Tens = Array("", "Ten", "Twenty", "Thirty", "Forty", "Fifty", "Sixty", "Seventy", "Eighty", "Ninety")
' Convert MyNumber to String
MyNumber = Trim(Str(MyNumber))
' Check if negative
If Left(MyNumber, 1) = "-" Then
Temp = "Minus "
MyNumber = Mid(MyNumber, 2)
End If
' Extract dollars and cents
If InStr(MyNumber, ".") Then
Temp = Temp & ConvertToWords(Left(MyNumber, InStr(MyNumber, ".") - 1)) & " dollars and "
MyNumber = Mid(MyNumber, InStr(MyNumber, ".") + 1)
End If
' Convert millions
If Len(MyNumber) > 6 Then
Temp = Temp & ConvertToWords(Left(MyNumber, Len(MyNumber) - 6)) & " million "
MyNumber = Mid(MyNumber, Len(MyNumber) - 5)
End If
' Convert thousands
If Len(MyNumber) > 3 Then
Temp = Temp & ConvertToWords(Left(MyNumber, Len(MyNumber) - 3)) & " thousand "
MyNumber = Mid(MyNumber, Len(MyNumber) - 2)
End If
' Convert hundreds
If Len(MyNumber) > 0 Then
If Val(Left(MyNumber, 1)) <> 0 Then
Temp = Temp & Ones(Val(Left(MyNumber, 1))) & " hundred "
MyNumber = Mid(MyNumber, 2)
End If
If Len(MyNumber) > 0 Then
If Val(MyNumber) < 20 Then
Temp = Temp & Teens(Val(MyNumber))
Else
Temp = Temp & Tens(Val(Left(MyNumber, 1)))
If Val(Right(MyNumber, 1)) <> 0 Then Temp = Temp & "-" & Ones(Val(Right(MyNumber, 1)))
End If
End If
End If
ConvertToWords = Temp
End Function