Convert Amount to Word

Hi,

Anybody has any idea what is the best way to convert Amount to word in the Notes Application?

E.g. $100 = One Hundred Dollar.

Thanks in advance.

Subject: Convert Amount to Word

Function NumToText(dblVal As Double) As String

Static Ones(0 To 9) As String 

Static Teens(0 To 9) As String 

Static Tens(0 To 9) As String 

Static Thousands(0 To 4) As String 

Static bInit As Boolean 

Dim i As Integer, bAllZeros As Boolean, bShowThousands As Boolean 

Dim strVal As String, strBuff As String, strTemp As String 

Dim nCol As Integer, nChar As Integer 





'Only handles positive values 

'Debug.Assert dblVal >= 0 





If bInit = False Then 

    'Initialize array 

	bInit = True 

	Ones(0) = "zero" 

	Ones(1) = "one" 

	Ones(2) = "two" 

	Ones(3) = "three" 

	Ones(4) = "four" 

	Ones(5) = "five" 

	Ones(6) = "six" 

	Ones(7) = "seven" 

	Ones(8) = "eight" 

	Ones(9) = "nine" 

	Teens(0) = "ten" 

	Teens(1) = "eleven" 

	Teens(2) = "twelve" 

	Teens(3) = "thirteen" 

	Teens(4) = "fourteen" 

	Teens(5) = "fifteen" 

	Teens(6) = "sixteen" 

	Teens(7) = "seventeen" 

	Teens(8) = "eighteen" 

	Teens(9) = "nineteen" 

	Tens(0) = "" 

	Tens(1) = "ten" 

	Tens(2) = "twenty" 

	Tens(3) = "thirty" 

	Tens(4) = "forty" 

	Tens(5) = "fifty" 

	Tens(6) = "sixty" 

	Tens(7) = "seventy" 

	Tens(8) = "eighty" 

	Tens(9) = "ninety" 

	Thousands(0) = "" 

	Thousands(1) = "thousand"   ' 

	Thousands(2) = "million" 

	Thousands(3) = "billion" 

	Thousands(4) = "trillion" 

End If 

'Trap errors 

On Error Goto NumToTextError 

'Get fractional part 

strBuff = " Dollar and " & Format((dblVal - Int(dblVal)) * 100, "00") & "/100"  & " Cents"

'Convert rest to string and process each digit 

strVal = Cstr(Int(dblVal)) 

'Non-zero digit not yet encountered 

bAllZeros = True 

'Iterate through string 

For i = Len(strVal) To 1 Step -1 

    'Get value of this digit 

	nChar = Val(Mid$(strVal, i, 1)) 

    'Get column position 

	nCol = (Len(strVal) - i) + 1 

    'Action depends on 1's, 10's or 100's column 

	Select Case (nCol Mod 3) 

	Case 1  '1's position 

		bShowThousands = True 

		If i = 1 Then 

                'First digit in number (last in loop) 

			strTemp = Ones(nChar) & " " 

		Elseif Mid$(strVal, i - 1, 1) = "1" Then 

                'This digit is part of "teen" number 

			strTemp = Teens(nChar) & " " 

			i = i - 1   'Skip tens position 

		Elseif nChar > 0 Then 

                'Any non-zero digit 

			strTemp = Ones(nChar) & " " 

		Else 

                'This digit is zero. If digit in tens and hundreds column 

                'are also zero, don't show "thousands" 

			bShowThousands = False 

                'Test for non-zero digit in this grouping 

			If Mid$(strVal, i - 1, 1) <> "0" Then 

				bShowThousands = True 

			Elseif i > 2 Then 

				If Mid$(strVal, i - 2, 1) <> "0" Then 

					bShowThousands = True 

				End If 

			End If 

			strTemp = "" 

		End If 

            'Show "thousands" if non-zero in grouping 

		If bShowThousands Then 

			If nCol > 1 Then 

				strTemp = strTemp & Thousands(nCol \ 3) 

				If bAllZeros Then 

					strTemp = strTemp & " " 

				Else 

					strTemp = strTemp & ", " 

				End If 

			End If 

                'Indicate non-zero digit encountered 

			bAllZeros = False 

		End If 

		strBuff = strTemp & strBuff 

	Case 2  '10's position 

		If nChar > 0 Then 

			If Mid$(strVal, i + 1, 1) <> "0" Then 

				strBuff = Tens(nChar) & "-" & strBuff 

			Else 

				strBuff = Tens(nChar) & " " & strBuff 

			End If 

		End If 

	Case 0  '100's position 

		If nChar > 0 Then 

			strBuff = Ones(nChar) & " hundred " & strBuff 

		End If 

	End Select 

Next i 

'Strip off empty 00/100 

If Right$(strBuff, 10) = "and 00/100" Then strBuff = Left$(strBuff, Len(strBuff) - 10) 

'Convert first letter to upper case 

strBuff = Ucase$(Left$(strBuff, 1)) & Mid$(strBuff, 2) 

EndNumToText:

'Return result 

NumToText = strBuff 

Exit Function 

NumToTextError:

strBuff = "#Error#" 

Resume EndNumToText 

End Function