Wrox Programmer Forums
| Search | Today's Posts | Mark Forums Read
Access Discussion of Microsoft Access database design and programming. See also the forums for Access ASP and Access VBA.
Welcome to the p2p.wrox.com Forums.

You are currently viewing the Access section of the Wrox Programmer to Programmer discussions. This is a community of software programmers and website developers including Wrox book authors and readers. New member registration was closed in 2019. New posts were shut off and the site was archived into this static format as of October 1, 2020. If you require technical support for a Wrox book please contact http://hub.wiley.com
  #1 (permalink)  
Old December 18th, 2003, 10:04 AM
Authorized User
 
Join Date: Jun 2003
Location: , FL, USA.
Posts: 91
Thanks: 0
Thanked 0 Times in 0 Posts
Default Convert Currency To Words

Hope someone can help me here.

I am looking for a way to take a currency amount (say $1234.56) and convert it to words (like One Thousand Two Hundred Thirty Four Dollars & Fifty-Six Cents).

What I am trying to do is create a form that is for check writing and when the user enters that amount of the check the equivalent words of the amount are appended to the appropriate line on the form.

Any assistance would be greatly appreciated.

Kenny Alligood
__________________
Kenny Alligood
  #2 (permalink)  
Old December 18th, 2003, 10:09 AM
Friend of Wrox
 
Join Date: Jun 2003
Location: , , United Kingdom.
Posts: 1,212
Thanks: 0
Thanked 1 Time in 1 Post
Default

http://www.fabalou.com/Access/Modules/numbertowords.asp
  #3 (permalink)  
Old December 18th, 2003, 10:19 AM
Authorized User
 
Join Date: Jun 2003
Location: , FL, USA.
Posts: 91
Thanks: 0
Thanked 0 Times in 0 Posts
Default

Never mind folks -- I found the answer. But for anyone that is interested the solution (http://www.ozgrid.com/VBA/CurrencyToWords.htm (from Microsoft)) is this:

Private Sub txtAmount_LostFocus()

     Dim strAmount As String

     strAmount = txtAmount

     Call ConvertCurrencyToEnglish(strAmount)

End Sub

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

         ReDim Place(9) As String
         Place(2) = " Thousand "
         Place(3) = " Million "
         Place(4) = " Billion "
         Place(5) = " Trillion "

         ' Convert strAmount to a string, trimming extra spaces.
         strAmount = Trim(Str(strAmount))

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

         ' If we find decimal place...
         If DecimalPlace > 0 Then
            ' Convert cents
            Temp = Left(Mid(strAmount, DecimalPlace + 1) & "00", 2)
            Cents = ConvertTens(Temp)

            ' Strip off cents from remainder to convert.
            strAmount = Trim(Left(strAmount, DecimalPlace - 1))
         End If

         Count = 1
         Do While strAmount <> ""
            ' Convert last 3 digits of strAmount to English dollars.
            Temp = ConvertHundreds(Right(strAmount, 3))
            If Temp <> "" Then Dollars = Temp & Place(Count) & Dollars
            If Len(strAmount) > 3 Then
               ' Remove last 3 converted digits from strAmount.
               strAmount = Left(strAmount, Len(strAmount) - 3)
            Else
               strAmount = ""
            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

          lblAmount.Caption = Dollars & Cents
      End Function



     Private Function ConvertHundreds(ByVal strAmount)
         Dim Result As String

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

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

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

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

         ConvertHundreds = Trim(Result)
      End Function



      Private Function ConvertTens(ByVal MyTens)
         Dim Result As String

         ' Is value between 10 and 19?
         If Val(Left(MyTens, 1)) = 1 Then
            Select Case Val(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 Val(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 Val(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


Kenny Alligood
  #4 (permalink)  
Old October 12th, 2017, 06:00 AM
Registered User
Points: 3, Level: 1
Points: 3, Level: 1 Points: 3, Level: 1 Points: 3, Level: 1
Activity: 0%
Activity: 0% Activity: 0% Activity: 0%
 
Join Date: Oct 2017
Posts: 1
Thanks: 0
Thanked 0 Times in 0 Posts
Default

Hello thank for the code.
Can you help me get 131 to read One hundred and thirty one

how do I introduce the "and"


Quote:
Originally Posted by Kenny Alligood View Post
Never mind folks -- I found the answer. But for anyone that is interested the solution (http://www.ozgrid.com/VBA/CurrencyToWords.htm (from Microsoft)) is this:

Private Sub txtAmount_LostFocus()

     Dim strAmount As String

     strAmount = txtAmount

     Call ConvertCurrencyToEnglish(strAmount)

End Sub

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

         ReDim Place(9) As String
         Place(2) = " Thousand "
         Place(3) = " Million "
         Place(4) = " Billion "
         Place(5) = " Trillion "

         ' Convert strAmount to a string, trimming extra spaces.
         strAmount = Trim(Str(strAmount))

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

         ' If we find decimal place...
         If DecimalPlace > 0 Then
            ' Convert cents
            Temp = Left(Mid(strAmount, DecimalPlace + 1) & "00", 2)
            Cents = ConvertTens(Temp)

            ' Strip off cents from remainder to convert.
            strAmount = Trim(Left(strAmount, DecimalPlace - 1))
         End If

         Count = 1
         Do While strAmount <> ""
            ' Convert last 3 digits of strAmount to English dollars.
            Temp = ConvertHundreds(Right(strAmount, 3))
            If Temp <> "" Then Dollars = Temp & Place(Count) & Dollars
            If Len(strAmount) > 3 Then
               ' Remove last 3 converted digits from strAmount.
               strAmount = Left(strAmount, Len(strAmount) - 3)
            Else
               strAmount = ""
            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

          lblAmount.Caption = Dollars & Cents
      End Function



     Private Function ConvertHundreds(ByVal strAmount)
         Dim Result As String

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

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

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

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

         ConvertHundreds = Trim(Result)
      End Function



      Private Function ConvertTens(ByVal MyTens)
         Dim Result As String

         ' Is value between 10 and 19?
         If Val(Left(MyTens, 1)) = 1 Then
            Select Case Val(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 Val(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 Val(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


Kenny Alligood


Similar Threads
Thread Thread Starter Forum Replies Last Post
Can XSLT convert amount to words LeoMathew XSLT 4 January 10th, 2018 04:09 AM
Convert Numbers to Words hasankelepir Classic ASP Basics 5 October 1st, 2007 07:15 AM
Currency mjbkelly Beginning VB 6 1 March 22nd, 2007 07:14 AM
System.Convert parameters for currency zoltac007 General .NET 0 September 27th, 2006 12:52 AM
convert number into words on acces form superparim Wrox Book Feedback 0 September 19th, 2005 01:55 PM





Powered by vBulletin®
Copyright ©2000 - 2020, Jelsoft Enterprises Ltd.
Copyright (c) 2020 John Wiley & Sons, Inc.