Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

  • Congratulations Shaun E on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

Currency Conversion to words

Status
Not open for further replies.

ahhuang

Programmer
Apr 1, 2002
61
SG
Hi All,
I like to know if there are any methods/functions in VB to help me to convert a currency to words as describe below?
Before conversion(could be integer/double) : 125.34
After conversion: dollars one hundred twenty five and cents thirty four

If there ain't any methods/functions, have u ever written out the coding yourslef that can share out with me??

Regards,
Ahhuang
 
Try this

Code:
Private Function NumToText(dblVal As Double) As String
    Static sOnes(0 To 9) As String
    Static sTeens(0 To 9) As String
    Static sTens(0 To 9) As String
    Static sThousands(0 To 4) As String
    Static bInit As Boolean
    
    Dim i As Integer
    Dim bAllZeros As Boolean
    Dim bShowsThousands As Boolean
    Dim sValue As String
    Dim sBuffer As String
    Dim sTemp As String
    Dim iCol As Integer
    Dim iChar As Integer
'
' Warning - this routine only handles positive values
'
    Debug.Assert dblVal > 0
    
    If bInit = False Then
        'Initialize array
        bInit = True
        sOnes(0) = "zero"
        sOnes(1) = "one"
        sOnes(2) = "two"
        sOnes(3) = "three"
        sOnes(4) = "four"
        sOnes(5) = "five"
        sOnes(6) = "six"
        sOnes(7) = "seven"
        sOnes(8) = "eight"
        sOnes(9) = "nine"
        sTeens(0) = "ten"
        sTeens(1) = "eleven"
        sTeens(2) = "twelve"
        sTeens(3) = "thirteen"
        sTeens(4) = "fourteen"
        sTeens(5) = "fifteen"
        sTeens(6) = "sixteen"
        sTeens(7) = "seventeen"
        sTeens(8) = "eighteen"
        sTeens(9) = "nineteen"
        sTens(0) = ""
        sTens(1) = "ten"
        sTens(2) = "twenty"
        sTens(3) = "thirty"
        sTens(4) = "forty"
        sTens(5) = "fifty"
        sTens(6) = "sixty"
        sTens(7) = "seventy"
        sTens(8) = "eighty"
        sTens(9) = "ninety"
        sThousands(0) = ""
        sThousands(1) = "thousand"   'US numbering
        sThousands(2) = "million"
        sThousands(3) = "billion"
        sThousands(4) = "trillion"
    End If
    '
    ' Setup Error Handler
    '
    On Error GoTo vbErrorHandler
    '
    ' Get fractional part of value (if any)
    '
    sBuffer = "and " & Format$((dblVal - Int(dblVal)) * 100, "00") & "/100"
    '
    ' Convert main part to string
    '
    sValue = CStr(Int(dblVal))
    
    bAllZeros = True
    
    For i = Len(sValue) To 1 Step -1
        iChar = Val(Mid$(sValue, i, 1))
        iCol = (Len(sValue) - i) + 1
        '
        'Action depends on 1's, 10's or 100's column
        '
        Select Case (iCol Mod 3)
            Case 1  '1's position
                bShowsThousands = True
                If i = 1 Then
                    sTemp = sOnes(iChar) & " "
                ElseIf Mid$(sValue, i - 1, 1) = "1" Then
                    sTemp = sTeens(iChar) & " "
                    i = i - 1
                ElseIf iChar > 0 Then
                    sTemp = sOnes(iChar) & " "
                Else
                    bShowsThousands = False
                    If Mid$(sValue, i - 1, 1) <> &quot;0&quot; Then
                        bShowsThousands = True
                    ElseIf i > 2 Then
                        If Mid$(sValue, i - 2, 1) <> &quot;0&quot; Then
                            bShowsThousands = True
                        End If
                    End If
                    sTemp = &quot;&quot;
                End If
                If bShowsThousands Then
                    If iCol > 1 Then
                        sTemp = sTemp & sThousands(iCol \ 3)
                        If bAllZeros Then
                            sTemp = sTemp & &quot; &quot;
                        Else
                            sTemp = sTemp & &quot;, &quot;
                        End If
                    End If
                    bAllZeros = False
                End If
                sBuffer = sTemp & sBuffer



            Case 2
                If iChar > 0 Then
                    If Mid$(sValue, i + 1, 1) <> &quot;0&quot; Then
                        sBuffer = sTens(iChar) & &quot;-&quot; & sBuffer
                    Else
                        sBuffer = sTens(iChar) & &quot; &quot; & sBuffer
                    End If
                End If
            Case 0
                If iChar > 0 Then
                    sBuffer = sOnes(iChar) & &quot; hundred &quot; & sBuffer
                End If
        End Select
    Next 

    sBuffer = UCase$(Left$(sBuffer, 1)) & Mid$(sBuffer, 2)

EndNumToText:
    NumToText = sBuffer
    Exit Function

vbErrorHandler:
    sBuffer = &quot;#Error#&quot;
    Resume EndNumToText
End Function

E
 
see faq181-1740 It does the conversion - but uses standard U.S. english syntax for the 'written' amount, as would be on a bank check.

MichaelRed
m.red@att.net

There is never time to do it right but there is always time to do it over
 
Status
Not open for further replies.

Part and Inventory Search

Sponsor

Back
Top