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(0 To 19) As String, ctt(0 To 9) As String, bmth(0 To 4) As String
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

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), "0")
        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:
ctu(0) = ""
ctu(1) = " One"
ctu(2) = " Two"
ctu(3) = " Three"
ctu(4) = " Four"
ctu(5) = " Five"
ctu(6) = " Six"
ctu(7) = " Seven"
ctu(8) = " Eight"
ctu(9) = " Nine"
ctu(10) = " Ten"
ctu(11) = " Eleven"
ctu(12) = " Twelve"
ctu(13) = " Thirteen"
ctu(14) = " Fourteen"
ctu(15) = " Fifteen"
ctu(16) = " Sixteen"
ctu(17) = " Seventeen"
ctu(18) = " Eighteen"
ctu(19) = " Nineteen"

ctt(0) = ""
ctt(1) = " Ten"
ctt(2) = " Twenty"
ctt(3) = " Thirty"
ctt(4) = " Fourty"
ctt(5) = " Fifty"
ctt(6) = " Sixty"
ctt(7) = " Seventy"
ctt(8) = " Eighty"
ctt(9) = " Ninety"

bmth(0) = ""
bmth(1) = " Hundred"
bmth(2) = " Thousand"
bmth(3) = " Million"
bmth(4) = " Billion"

cardseg(4) = Mid(strNum, 1, 3)
cardseg(3) = Mid(strNum, 4, 3)
cardseg(2) = Mid(strNum, 7, 3)
cardseg(1) = Mid(strNum, 10, 3)
Return

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

=CardText(A1,2)