 |
 |
 | |
 | |
 | |
 |
|
|
| |
| |
| |
|
Last updated: 27 Jun 2001
Submitted by Paul Bent, Northwind IT Systems
fCurrencyToWords converts any currency value to text, adds the currency name and handles cents in nn/100 format. It can be adapted to support multiple languages.
Public Function fCurrencyToWords(Byval curValue As Currency, _ Byval strCurrency As String) As String '--- Converts a monetary value to words '--- Parameters ' [In] ' curValue the monetary value to be converted. Note the calling proc ' must use CCur() if the value to be passed is not currency data type ' strCurrency name of the currency such as dollars or pounds ' function assumes it is plural '--- Return value ' returns the value in words else an empty string if an error occurred '--- Author Paul Bent, Northwind IT Systems '--- Contact paulbent@nothwindit.co.uk 'Constants representing conversion strings 'Note these could be declared as Public and moved into a LSS file 'There could be several versions of the LSS file to provide multiple language support Const W_MILL = "million" Const W_THOU = "thousand" Const W_HUND = "hundred" Const W_1 = "one" Const W_2 = "two" Const W_3 = "three" Const W_4 = "four" Const W_5 = "five" Const W_6 = "six" Const W_7 = "seven" Const W_8 = "eight" Const W_9 = "nine" Const W_10 = "ten" Const W_11 = "eleven" Const W_12 = "twelve" Const W_13 = "thirteen" Const W_14 = "fourteen" Const W_15 = "fifteen" Const W_16 = "sixteen" Const W_17 = "seventeen" Const W_18 = "eighteen" Const W_19 = "nineteen" Const W_20 = "twenty" Const W_30 = "thirty" Const W_40 = "forty" Const W_50 = "fifty" Const W_60 = "sixty" Const W_70 = "seventy" Const W_80 = "eighty" Const W_90 = "ninety" Dim lngValue As Long 'Integer portion of curValue Dim intNum As Integer 'Digit set being processed in integer portion of curValue Dim intC1 As Integer 'Counter for parsing loop Dim strTmp1 As String 'Temp string buffer Dim strTmp2 As String 'Temp string buffer Dim strRtn As String 'Buffer to build the return string 'Check curValue is not zero or negative If curValue <= 0 Then Exit Function 'Get the integer portion of curValue lngValue = Int(curValue) 'Handle cents strRtn = Format$(100 * (curValue - lngValue), "00") & "/100" 'Handle the integer portion If lngValue > 0 Then 'Need to insert " and " before the cents If Len(strCurrency) = 0 Then 'No currency name to be inserted strRtn = " and " & strRtn Else 'Currency name to be inserted, check the plurality 'Might need changes here if not English language If lngValue = 1 Then 'Currency should be singular If Right$(strCurrency, 1) = "s" Then strCurrency = Left$(strCurrency, Len(strCurrency) - 1) End If End If 'Insert the currency name strRtn = strCurrency & " and " & strRtn End If 'Zero prefil to ensure digits processed are in sets of three strTmp1 = "000" & Cstr(lngValue) 'Process chars in strTmp in sets of three from least to most significant Do While Isnumeric(strTmp1) And Val(strTmp1) > 0 'Handle tens and units 'Convert to numeric intNum = Val(Right$(strTmp1, 2)) 'Remove them from the temp buffer strTmp1 = Left$(strTmp1, Len(strTmp1) - 2) 'Initialize the second buffer strTmp2 = "" 'Convert to word If intNum > 9 And intNum < 20 Then Select Case intNum - 9 Case 1 strTmp2 = W_10 & " " & strTmp2 Case 2 strTmp2 = W_11 & " " & strTmp2 Case 3 strTmp2 = W_12 & " " & strTmp2 Case 4 strTmp2 = W_13 & " " & strTmp2 Case 5 strTmp2 = W_14 & " " & strTmp2 Case 6 strTmp2 = W_15 & " " & strTmp2 Case 7 strTmp2 = W_16 & " " & strTmp2 Case 8 strTmp2 = W_17 & " " & strTmp2 Case 9 strTmp2 = W_18 & " " & strTmp2 Case 10 strTmp2 = W_19 & " " & strTmp2 End Select Elseif intNum > 0 Then Select Case Val(Right$(Cstr(intNum), 1)) Case 1 strTmp2 = W_1 & " " & strTmp2 Case 2 strTmp2 = W_2 & " " & strTmp2 Case 3 strTmp2 = W_3 & " " & strTmp2 Case 4 strTmp2 = W_4 & " " & strTmp2 Case 5 strTmp2 = W_5 & " " & strTmp2 Case 6 strTmp2 = W_6 & " " & strTmp2 Case 7 strTmp2 = W_7 & " " & strTmp2 Case 8 strTmp2 = W_8 & " " & strTmp2 Case 9 strTmp2 = W_9 & " " & strTmp2 End Select End If If intNum >= 20 Then Select Case Left$(Cstr(intNum), 1) Case "1" strTmp2 = "Error" & " " & strTmp2 Case "2" strTmp2 = W_20 & " " & strTmp2 Case "3" strTmp2 = W_30 & " " & strTmp2 Case "4" strTmp2 = W_40 & " " & strTmp2 Case "5" strTmp2 = W_50 & " " & strTmp2 Case "6" strTmp2 = W_60 & " " & strTmp2 Case "7" strTmp2 = W_70 & " " & strTmp2 Case "8" strTmp2 = W_80 & " " & strTmp2 Case "9" strTmp2 = W_90 & " " & strTmp2 End Select End If 'Handle hundreds intNum = Val(Right$(strTmp1, 1)) strTmp1 = Left$(strTmp1, Len(strTmp1) - 1) If intNum > 0 Then If Len(strTmp2) = 0 Then strTmp2 = W_HUND & " " & strTmp2 Else strTmp2 = W_HUND & " and " & strTmp2 End If Select Case intNum Case 1 strTmp2 = W_1 & " " & strTmp2 Case 2 strTmp2 = W_2 & " " & strTmp2 Case 3 strTmp2 = W_3 & " " & strTmp2 Case 4 strTmp2 = W_4 & " " & strTmp2 Case 5 strTmp2 = W_5 & " " & strTmp2 Case 6 strTmp2 = W_6 & " " & strTmp2 Case 7 strTmp2 = W_7 & " " & strTmp2 Case 8 strTmp2 = W_8 & " " & strTmp2 Case 9 strTmp2 = W_9 & " " & strTmp2 End Select End If 'Handle thousands and greater If Not Len(strTmp2) = 0 Then Select Case intC1 / 3 Case Is < 1 strRtn = strTmp2 & strRtn Case 1 If Instr(1, strRtn, W_HUND, 5) > 0 Then strRtn = strTmp2 & W_THOU & " " & strRtn Else strRtn = strTmp2 & W_THOU & " and " & strRtn End If Case Else If Instr(1, strRtn, W_HUND, 5) > 0 Or _ Instr(1, strRtn, W_THOU, 5) > 0 Then strRtn = strTmp2 & W_MILL & " " & strRtn Else strRtn = strTmp2 & W_MILL & " and " & strRtn End If End Select End If 'Increment the digit counter intC1 = intC1 + 3 Loop 'Return value fCurrencyToWords = strRtn End If End Function