ACC2000: How to Convert Currency or Numbers to English Words in a Data Access Page

• Microsoft Access 2000

SUMMARY

This article shows you how to create a sample, user-defined script named ConvertCurrencyToEnglish that you can use to convert a numeric value to an English word representation on a data access page. For example, the script returns the following words for the number 1234.56:

One Thousand Two Hundred Thirty Four Dollars And Fifty Six Cents

MORE INFORMATION

To create the ConvertCurrencyToEnglish() script, follow these steps:

1. Open the sample database Northwind.mdb.



2. In the Database window, click Pages under Objects, and then click New.



3. Select Design View, and then click OK.



4. In Design view of the new page, click Properties on the View menu, and then click the All tab in the property sheet.



5. Add two text boxes to the Section: Unbound.



6. Click the label for the first text box, and set the following properties:




   InnerText: Money
   Left: 0in
   TextAlign: right
   Top: 0.25in
   Width: 0.9in 

7. Click the first text box, and set the following properties:




   Id: txtMoney
   Left: 1in
   Top: 0.25in
   Width: 1in 

8. Click the label for the second text box, and set the following properties:




   InnerText: English
   Left: 0in
   TextAlign: right
   Top: 0.5in
   Width: 0.9in 

9. Click the second text box, and set the following properties:




   Id: txtEnglish
   Left: 1in
   Top: 0.5in
   Width: 6in 

10. On the Tools menu, point to Macro, and then click Microsoft Script Editor.



11. Press CTRL+END and type the following script:




<SCRIPT event=OnChange for=txtMoney language=VBScript>
<!--
Dim X
X = ConvertCurrencyToEnglish(Document.All.Item("txtMoney").Value)
-->
</SCRIPT>

<SCRIPT Language=VBScript>
<!--
Option Explicit

Function ConvertCurrencyToEnglish (ByVal MyNumber)
   Dim Temp
   Dim Dollars, Cents
   Dim DecimalPlace, Count

   ReDim Place(9)

   Place(2) = " Thousand "
   Place(3) = " Million "
   Place(4) = " Billion "
   Place(5) = " Trillion "

   'Convert MyNumber to a string, trimming extra spaces.
   MyNumber = Trim(CStr(MyNumber))

   'Find decimal place.
   DecimalPlace = InStr(MyNumber, ".")

   'If we find decimal place...
   If DecimalPlace > 0 Then
      'Convert cents
      Temp = Left(Mid(MyNumber, DecimalPlace + 1) & "00", 2)
      Cents = ConvertTens(Temp)
      'Strip off cents from remainder to convert.
      MyNumber = Trim(Left(MyNumber, DecimalPlace - 1))
   End If

   Count = 1

   Do While MyNumber <> ""
      'Convert last 3 digits of MyNumber to English dollars.
      Temp = ConvertHundreds(Right(MyNumber, 3))
      If Temp <> "" Then Dollars = Temp & Place(Count) & Dollars
      If Len(MyNumber) > 3 Then
         'Remove last 3 converted digits from MyNumber.
         MyNumber = Left(MyNumber, Len(MyNumber) - 3)
      Else
         MyNumber = ""
      End If
      Count = Count + 1
   Loop

   'Clean up dollars.
   Select Case Dollars
      Case ""
         Dollars = "No Dollars"
      Case "One"
         Dollars = "One Dollar"
      Case Else
         Dollars = Dollars & " Dollars"
   End Select

   'Clean up cents.
   Select Case Cents
      Case ""
         Cents = " And No Cents"
      Case "One"
         Cents = " And One Cent"
      Case Else
         Cents = " And " & Cents & " Cents"
   End Select

   'ConvertCurrencyToEnglish = Dollars & Cents
   Document.All.Item("txtEnglish").Value = Dollars & Cents
End Function

Private Function ConvertHundreds (ByVal MyNumber)
   Dim Result

   'Exit if there is nothing to convert.
   If CInt(MyNumber) = 0 Then Exit Function

   'Append leading zeros to number.
   MyNumber = Right("000" & MyNumber, 3)

   'Do we have a hundreds place digit to convert?
   If Left(MyNumber, 1) <> "0" Then
      Result = ConvertDigit(Left(MyNumber, 1)) & " Hundred "
   End If

   'Do we have a tens place digit to convert?
   If Mid(MyNumber, 2, 1) <> "0" Then
      Result = Result & ConvertTens(Mid(MyNumber, 2))
   Else
      'If not, then convert the ones place digit.
      Result = Result & ConvertDigit(Mid(MyNumber, 3))
   End If

   ConvertHundreds = Trim(Result)
End Function

Private Function ConvertTens (ByVal MyTens)
   Dim Result

   'Is value between 10 and 19?
   If CInt(Left(MyTens, 1)) = 1 Then
      Select Case CInt(MyTens)
         Case 10: Result = "Ten"
         Case 11: Result = "Eleven"
         Case 12: Result = "Twelve"
         Case 13: Result = "Thirteen"
         Case 14: Result = "Fourteen"
         Case 15: Result = "Fifteen"
         Case 16: Result = "Sixteen"
         Case 17: Result = "Seventeen"
         Case 18: Result = "Eighteen"
         Case 19: Result = "Nineteen"
         Case Else
      End Select
   Else
      '... otherwise it's between 20 and 99.
      Select Case CInt(Left(MyTens, 1))
         Case 2: Result = "Twenty "
         Case 3: Result = "Thirty "
         Case 4: Result = "Forty "
         Case 5: Result = "Fifty "
         Case 6: Result = "Sixty "
         Case 7: Result = "Seventy "
         Case 8: Result = "Eighty "
         Case 9: Result = "Ninety "
         Case Else
      End Select
      'Convert ones place digit.
      Result = Result & ConvertDigit(Right(MyTens, 1))
   End If

   ConvertTens = Result
End Function

Private Function ConvertDigit (ByVal MyDigit)
   Select Case CInt(MyDigit)
      Case 1: ConvertDigit = "One"
      Case 2: ConvertDigit = "Two"
      Case 3: ConvertDigit = "Three"
      Case 4: ConvertDigit = "Four"
      Case 5: ConvertDigit = "Five"
      Case 6: ConvertDigit = "Six"
      Case 7: ConvertDigit = "Seven"
      Case 8: ConvertDigit = "Eight"
      Case 9: ConvertDigit = "Nine"
      Case Else: ConvertDigit = ""
   End Select
End Function
-->
</SCRIPT> 

12. On the File menu, click Save, and save the page as dapMoney.htm.



13. On the View menu, click View in Browser, type 1234.56 in the Money box, and then press TAB to move to the English box.

Additional query words: DAP writing checks report printing

Keywords          : kbdta AccDAP DAPScriptHowTo dtavbscript 
Version           : WINDOWS:2000
Platform          : WINDOWS 
Issue type        : kbhowto 

Last Reviewed: July 9, 1999