Results 1 to 5 of 5
  1. #1
    Join Date
    Jan 2013
    Location
    Dhaka
    Posts
    1

    Convert in words

    How can I covert a number in words. e.g If I entry 504 in a cell then Five hundred and four will display in another cell. Is it possible?

  2. #2
    Join Date
    Nov 2004
    Location
    out on a limb
    Posts
    12,419
    yes
    write a function that does it for you
    heck there may even be a function that exists already...
    I'd rather be riding on the Tiger 800 or the Norton

  3. #3
    Join Date
    Jan 2009
    Location
    Kerala, India
    Posts
    159
    Copy and paste the following Code into a Standard VBA Module of your Workbook and save the Module:

    Code:
    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
    To try out the code, enter some numer (12345.6784) in Cell A1.
    Enter the following expression in Cell B1:
    Code:
    =CardText(A1,2)
    Try it out with different values in Cell A1.

    For more details visit the link: Cardinal Text Format
    www.MsAccessTips.com (Learn MS-Access Tips & Tricks)
    Learn Advanced MS-Access Programming with sample VBA Code.

    All responses based on Access 2003/2007

  4. #4
    Join Date
    Feb 2013
    Posts
    15
    hello Friend...


    Function available at the net covers USD as currency, whereas I needed it in Indian Rupees. I have modified this to give results in any currency. The revised version gives me results as shown in the screen cast below. View this link..

    i978.photobucket.com/albums/ae263/yogeshguptaonline/spellcurr.gif

  5. #5
    Join Date
    Jan 2009
    Location
    Kerala, India
    Posts
    159
    Good work. If you could post the modified code here, it will be useful for others too.

    Thanks
    www.MsAccessTips.com (Learn MS-Access Tips & Tricks)
    Learn Advanced MS-Access Programming with sample VBA Code.

    All responses based on Access 2003/2007

Tags for this Thread

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •