Learn Microsoft Access Advanced Programming Techniques, Tips and Tricks.

Friday, January 2, 2009

Cardinal Text Format In Access

Introduction

The other day, a colleague asked me to open Microsoft Word, type the expression =Rand() on a blank line, and press Enter. What happened next felt like magic — something I hadn’t known until that moment. Instantly, Word replaced the expression with a block of sample text, repeating the following sentence fifteen times (arranged in three rows and five columns):

The quick brown fox jumps over the lazy dog.

Open a Word document and try it yourself: type =Rand() on its own line and press Enter. Word will replace the expression with a block of sample text — the sentence below repeated fifteen times (arranged in three rows and five columns). The sentence contains every letter of the alphabet. You can control the output by passing parameters to the function; for example, it =Rand(5,1) prints the sentence five times in one column. It’s a built-in Word feature that looks like a randomizer but isn’t — it’s just a quick way to insert sample text, and it only works when the expression is on a separate line.

There’s another Word feature I wish Access had natively: formatting numeric values as cardinal text. In Word mail merge fields, you can use switches such as \* CardText or \* DollarText — for example, the mail-merge expression { = 9.20 + 5.35 \* CardText } produces fourteen and 55/100 when merged. Adding the \* Caps switch (e.g., { = 9.20 + 5.35 \* DollarText \* Caps }) capitalizes the first letter of each word, which is handy for printing amounts on invoices.

That’s exactly the kind of output I wanted for Access invoices, so I wrote a VBA function to convert numeric values to cardinal text.

The CardText() Function

Copy and paste the following Code into a Global Module of your Database and save it:

Public Function CardText(ByVal inNumber As Double, Optional ByVal precision As Integer = 2) As String
'------------------------------------------------------------------------
'Author : a.p.r. pillai
'Date   : December 2008
'URL    : www.msaccesstips.com
'All Rights Reserved by www.msaccesstips.com
'------------------------------------------------------------------------
Dim ctu, ctt, bmth
Dim strNum As String, j As Integer, k As Integer, fmt As String
Dim h As Integer, xten As Integer, yten As Integer
Dim cardseg(1 To 4) As String, txt As String, d As String, txt2 As String
Dim locn As Integer, xfract As String, xhundred As String
Dim xctu As String, xctt As String, xbmth As String

On Error GoTo CardText_Err

strNum = Trim(Str(inNumber))
locn = InStr(1, strNum, ".")
'Check Decimal Places and rounding
If locn > 0 Then
  xfract = Mid(strNum, locn + 1)
 strNum = Left(strNum, locn - 1)
    If precision > 0 Then
        If Len(xfract) < precision Then 
        	xfract = xfract & String((precision - Len(xfract)), chr(48))
        ElseIf Len(xfract) > precision Then
            xfract = Format(Int(Val(Left(xfract, precision + 1)) / 10 + 0.5), String(precision, "0"))
        End If
        xfract = IIf(Val(xfract) > 0, xfract & "/" & 10 ^ precision, "")
    Else
        strNum = Val(strNum) + Int(Val("." & xfract) + 0.5)
        xfract = ""
    End If
End If

h = Len(strNum)
If h > 12 Then
'if more than 12 digits take only 12 (max. 999 Billion)
'extra value will get truncated from left.
   strNum = Right(strNum, 12)
Else
   strNum = String(12 - h, "0") & strNum
End If

GoSub initSection

txt2 = ""
For j = 1 To 4
    If Val(cardseg(j)) = 0 Then
       GoTo NextStep
    End If
    txt = ""
    For k = 3 To 1 Step -1
      Select Case k
       Case 3
            xten = Val(Mid(cardseg(j), k - 1, 1))
            If xten = 1 Then
                txt = ctu(10 + Val(Mid(cardseg(j), k, 1)))
            Else
                txt = ctt(xten) & ctu(Val(Mid(cardseg(j), k, 1)))
            End If
        Case 1
            yten = Val(Mid(cardseg(j), k, 1))
            xhundred = ctu(yten) & IIf(yten > 0, bmth(1), "") & txt
            Select Case j
                Case 2
                      d = bmth(2)
                Case 3
                    d = bmth(3)
                Case 4
                    d = bmth(4)
            End Select
            txt2 = xhundred & d & txt2
    End Select
   Next
NextStep:
Next

If Len(txt2) = 0 And Len(xfract) > 0 Then
    txt2 = xfract & " only. "
ElseIf Len(txt2) = 0 And Len(xfract) = 0 Then
    txt2 = ""
Else
  txt2 = txt2 & IIf(Len(xfract) > 0, " and " & xfract, "") & " only."
End If

CardText = txt2

CardText_Exit:
Exit Function

initSection:
xctu = ", One, Two, Three, Four, Five, Six, Seven, Eight, Nine, Ten, Eleven, Twelve,"
xctu = xctu & " Thirteen, Fourteen, Fifteen, Sixteen, Seventeen, Eighteen, Nineteen"
ctu = Split(xctu, ",")

xctt = ", Ten, Twenty, Thirty, Fourty, Fifty, Sixty, Seventy, Eighty, Ninety"
ctt = Split(xctt, ",")

xbmth = ", Hundred, Thousand, Million, Billion"
bmth = Split(xbmth, ",")
k = 4
For j = 1 To 10 Step 3
    cardseg(k) = Mid(strNum, j, 3)
    k = k - 1
Next
Return

CardText_Err:
CardText = ""
MsgBox Err.Description, , "CardText()"
Resume CardText_Exit
End Function

The CardText() or the DollarText.

Sample Demo Runs

The Function name CardText() is derived from MS Word Number Format Switch \* CardText. The CardText() Function accepts a maximum value of 10^12-1 or up to 999 Billion. For most applications, this will be sufficient. Passing a Value greater than this will get truncated from the left.

The CardText() Function accepts two parameters, and the second one is optional. The second parameter controls the number of digits after the decimal point.

By default, the CardText() Function will round off the fractional part, if present, to two decimal places when the second parameter value is omitted.

To try out the Code, you may open the VBA Window (Alt+F11) and open the Immediate Window (Ctrl+G) and type the following statement or a similar one with a different value or Expression:

Example:? CardText(1234.5678,3) will produce the result shown below.

Result: One Thousand Two Hundred Thirty-Four and 568/1000 only.

The first parameter can be a Number or an Expression that evaluates to a Numeric Value. If the second parameter is zero, then the Number is rounded to the next highest Integer.

Example:? CardText(1234.5678,0)

Result: Thousand Two Hundred Thirty-Five only.

To change the output to upper-case or lower-case letters, enclose the CardText() Function in UCase() or LCase() built-in function, respectively.

Example:? UCase(CardText(1234.5678))

Result: ONE THOUSAND TWO HUNDRED THIRTY-FOUR AND 57/100 ONLY.

To prefix a Currency Description, use the following example:

Example:? "Dollars" & CardText(1234.5678)

Or

="Dollars" & CardText([UnitPrice]) on Forms  or  Reports.

Result: Dollars One Thousand Two Hundred Thirty-Four and 57/100 only.

Try the Function on Form or Report with the data field Value as input.

The CardText() Function is not extensively field-tested, and if you find bugs, please let me know. Use it at your own risk.

Any suggestions for improvement are welcome.



No comments:

Post a Comment

Comments subject to moderation before publishing.

Powered by Blogger.