My pleasure, Mike.
Regards,
Bill Mosca
From: MS_Access_Professionals@yahoogroups.com [mailto:MS_Access_Professionals@yahoogroups.com]
Sent: Tuesday, November 06, 2018 12:51 PM
To: MS_Access_Professionals@yahoogroups.com
Subject: Re: [MS_AccessPros] Re: Access 2010 =NumWord Expression
Thank you! Thank you! Thank you!
---In MS_Access_Professionals@yahoogroups.com, <wrmosca@...> wrote :
Mike - Below is an entire module for doing what you want. While in the code editor, create a new module. Copy and paste all of this into the module.
'****Start Code****
Option Compare Database
Option Explicit
Function ConvertCurrencyToEnglish(ByVal MyNumber)
'test: ConvertCurrencyToEnglish(1234.56)
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 MyNumber to a string, trimming extra spaces.
MyNumber = Trim(Str(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
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
Private Function ConvertHundreds(ByVal MyNumber)
Dim Result As String
' Exit if there is nothing to convert.
If Val(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 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
Public Function DateToWords(varDate As Variant)
'Purpose : Convert date to English.
'DateTime : 6/20/2006 11:36
'Author : Bill Mosca
'Calls : ConvertCurrencyToEnglish for year portion.
Dim intDay As Integer
Dim strDay As String
Dim strMonth As String
Dim strYear As String
Dim intYear As Long
'Leave if no date passed.
If IsNull(varDate) Then Exit Function
intDay = Day(varDate)
Select Case intDay
Case 1
strDay = "First"
Case 2
strDay = "Second"
Case 3
strDay = "Third"
Case 4
strDay = "Fourth"
Case 5
strDay = "Fifth"
Case 6
strDay = "Sixth"
Case 7
strDay = "Seventh"
Case 8
strDay = "Eighth"
Case 9
strDay = "Ninth"
Case 10
strDay = "Tenth"
Case 11
strDay = "Eleventh"
Case 12
strDay = "Twelfth"
Case 13
strDay = "Thirteenth"
Case 14
strDay = "Fourteenth"
Case 15
strDay = "Fifteenth"
Case 16
strDay = "Sixteenth"
Case 17
strDay = "Seventeenth"
Case 18
strDay = "Eighteenth"
Case 19
strDay = "Nineteenth"
Case 20
strDay = "Twentieth"
Case 21
strDay = "Twenty First"
Case 22
strDay = "Twenty Second"
Case 23
strDay = "Twenty Third"
Case 24
strDay = "Twenty Fourth"
Case 25
strDay = "Twenty Fifth"
Case 26
strDay = "Twenty Sixth"
Case 27
strDay = "Twenty Seventh"
Case 28
strDay = "Twenty Eighth"
Case 29
strDay = "Twenty Ninth"
Case 30
strDay = "Thirtieth"
Case 31
strDay = "Thirty First"
End Select
strMonth = Format(varDate, "mmmm")
intYear = Year(varDate)
strYear = ConvertCurrencyToEnglish(intYear)
'Remove Dollars And No Cents from strYear
strYear = Replace(strYear, " Dollars And No Cents", "")
DateToWords = strDay & " day of " & strMonth & " " & strYear
End Function
'****End Code***
---In MS_Access_Professionals@yahoogroups.com, <mtamiazzo@...> wrote :
Hello Bill,
I really appreciate your help!
I see by the below code below:
"Can handle numbers from 0 to $999,999.99"
and
'** Add the word "thousand" if necessary.
If AmountPassed > 999.99 And LoopCount = 1 Then
English = English + " Thousand "
End If
is why I'm not able to apply it to numbers >= 1M.
Option Compare Database 'Use database order for string comparisons
Option Explicit 'Require explicit variable declaration
'This routine (c) 1994 Alan Simpson author of Understanding Access 2.0 by Sybex
'Variables used in NumWord() procedure defined here in Declarations.
Dim EngNum(90) As String
Dim StringNum As String, Chunk As String, English As String
Dim Hundreds As Integer, Tens As Integer, Ones As Integer
Dim LoopCount As Integer, StartVal As Integer
Dim TensDone As Integer
Dim Pennies As String
Static Function NumWord(ByVal AmountPassed As Currency) As String
'** Convert a number to words for filling in the Amount of a check
'** Example: NumWord(120.45) returns ONE HUNDRED TWENTY AND 45/100
'** Can handle numbers from 0 to $999,999.99
'** Created by Alan Simpson: Fax (619)756-0159
'** First working version, not yet fully tuned for speed or brevity.
'** The array below, and other variables, are dimensioned
'** in the Declarations section.
'** Fill EngNum array, if it's not filled already)
If Not EngNum(1) = "One" Then
EngNum(0) = ""
EngNum(1) = "One"
EngNum(2) = "Two"
EngNum(3) = "Three"
EngNum(4) = "Four"
EngNum(5) = "Five"
EngNum(6) = "Six"
EngNum(7) = "Seven"
EngNum(8) = "Eight"
EngNum(9) = "Nine"
EngNum(10) = "Ten"
EngNum(11) = "Eleven"
EngNum(12) = "Twelve"
EngNum(13) = "Thirteen"
EngNum(14) = "Fourteen"
EngNum(15) = "Fifteen"
EngNum(16) = "Sixteen"
EngNum(17) = "Seventeen"
EngNum(18) = "Eighteen"
EngNum(19) = "Nineteen"
EngNum(20) = "Twenty"
EngNum(30) = "Thirty"
EngNum(40) = "Forty"
EngNum(50) = "Fifty"
EngNum(60) = "Sixty"
EngNum(70) = "Seventy"
EngNum(80) = "Eighty"
EngNum(90) = "Ninety"
End If
'** Convert incoming Currency value to a string for parsing.
StringNum = Format$(AmountPassed, "000000.00")
'** Initialize other variables
English = ""
LoopCount = 1
StartVal = 1
Pennies = Mid$(StringNum, 8, 2)
'** Just in case the check is for less than a buck...
If AmountPassed < 1 Then
English = "Zero"
End If
'** Now do each 3-digit section of number.
While LoopCount <= 2
Chunk = Mid$(StringNum, StartVal, 3)
Hundreds = Val(Mid$(Chunk, 1, 1))
Tens = Val(Mid$(Chunk, 2, 2))
Ones = Val(Mid$(Chunk, 3, 1))
'** Do the hundreds portion of 3-digit number
If Val(Chunk) > 99 Then
English = English & EngNum(Hundreds) & " Hundred "
End If
'** Do the tens & ones portion of 3-digit number
TensDone = False
'** Is it less than 10?
If Tens < 10 Then
English = English & " " & EngNum(Ones)
TensDone = True
End If
'** Is it a teen?
If (Tens >= 11 And Tens <= 19) Then
English = English & EngNum(Tens)
TensDone = True
End If
'** Is it Evenly Divisible by 10?
If (Tens / 10#) = Int(Tens / 10#) Then
English = English & EngNum(Tens)
TensDone = True
End If
'** Or is it none of the above?
If Not TensDone Then
English = English & EngNum((Int(Tens / 10)) * 10)
English = English & " " & EngNum(Ones)
End If
'** Add the word "thousand" if necessary.
If AmountPassed > 999.99 And LoopCount = 1 Then
English = English + " Thousand "
End If
'** Do pass through second three digits
LoopCount = LoopCount + 1
StartVal = 4
Wend
'** Done: Return english with pennies tacked on.
NumWord = Trim(English) & " and " & Pennies & "/100"
End Function
Posted by: "Bill Mosca" <wrmosca@comcast.net>
| Reply via web post | • | Reply to sender | • | Reply to group | • | Start a New Topic | • | Messages in this topic (15) |
Tidak ada komentar:
Posting Komentar