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 bkrike on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

conver currency to text 1

Status
Not open for further replies.

romanzero

Technical User
Dec 6, 2002
36
US
Hi,

I lifted the following code from an old thread. It works fine except it does not convert the "cents" into text when the "cents" = a number divisible by 10 (e.g., 10, 20, 30, 40).

I have gone through the code as best as an amature can, but I cannot for the life of me figure out what is missing.

I plead for your help!

Private Sub curValue_Click()
Me.MyNumber = GetDollarSpelling(Me.curValue)

'Hope this helps. If you have trouble getting it to work, let me know.


'----------
End Sub

Function GetDollarSpelling(dblValue As Double) As String
Dim centspot As Integer, dollarlen As Integer
Dim dollars As Double, cents As Integer
Dim hundreds As Integer, thousands As Integer
Dim millions As Integer, billions As Integer
Dim centtext As String, huntext As String, thoutext As String
Dim milltext As String, billtext As String, temptext As String

If dblValue < 0.01 Then
temptext = "Zero"
Else
centspot = InStr(dblValue, ".")
If centspot > 0 Then
cents = Right(dblValue, 2)
dollars = Left(dblValue, centspot - 1)
Else
cents = 0
dollars = dblValue
End If

dollarlen = Len(CStr(dollars))

If dollarlen > 0 Then
Select Case dollars
Case 1 To 999
Select Case dollars
Case 1 To 9
hundreds = Right(dollars, 1)
Case 10 To 99
hundreds = Right(dollars, 2)
Case 100 To 999
hundreds = Right(dollars, 3)
End Select
Case 1000 To 999999
hundreds = Right(dollars, 3)
Select Case dollars
Case 1000 To 9999
thousands = Left(dollars, 1)
Case 10000 To 99999
thousands = Left(dollars, 2)
Case 100000 To 999999
thousands = Left(dollars, 3)
End Select
Case 1000000 To 999999999
hundreds = Right(dollars, 3)
thousands = Mid(dollars, (dollarlen - 5), 3)
Select Case dollars
Case 1000000 To 9999999
millions = Left(dollars, 1)
Case 10000000 To 99999999
millions = Left(dollars, 2)
Case 100000000 To 999999999
millions = Left(dollars, 3)
End Select
Case 1000000000 To 999999999999#
hundreds = Right(dollars, 3)
thousands = Mid(dollars, (dollarlen - 5), 3)
millions = Mid(dollars, (dollarlen - 8), 3)
Select Case dollars
Case 1000000000 To 9999999999#
billions = Left(dollars, 1)
Case 10000000000# To 99999999999#
billions = Left(dollars, 2)
Case 100000000000# To 999999999999#
billions = Left(dollars, 3)
End Select
End Select
End If

If cents > 0 Then centtext = GetDollarString("cents", cents)
If hundreds > 0 Then huntext = GetDollarString("hundreds", hundreds)
If thousands > 0 Then thoutext = GetDollarString("thousands", thousands)
If millions > 0 Then milltext = GetDollarString("millions", millions)
If billions > 0 Then billtext = GetDollarString("billions", billions)

If billtext = "" Then
If milltext = "" Then
If thoutext = "" Then
If huntext = "" Then
temptext = centtext
Else
temptext = huntext & " Dollars and" & centtext
End If
Else
temptext = thoutext & " " & huntext & " Dollars and" & centtext
End If
Else
temptext = milltext & " " & thoutext & " " & huntext & " Dollars and" & centtext
End If
Else
temptext = billtext & " " & milltext & " " & thoutext & " " & huntext & " Dollars and" & centtext
End If
End If

If Right(temptext, 1) = "d" Then temptext = Left(temptext, Len(temptext) - 4)
GetDollarSpelling = Trim(temptext)
End Function

Function GetDollarString(strPart As String, intPart As Integer) As String
Dim strDollars As String

If intPart > 99 Then
Select Case Mid(intPart, 1, 1)
Case 1: strDollars = "One Hundred"
Case 2: strDollars = "Two Hundred"
Case 3: strDollars = "Three Hundred"
Case 4: strDollars = "Four Hundred"
Case 5: strDollars = "Five Hundred"
Case 6: strDollars = "Six Hundred"
Case 7: strDollars = "Seven Hundred"
Case 8: strDollars = "Eight Hundred"
Case 9: strDollars = "Nine Hundred"
End Select
End If

If strPart = "Cents" Then
If intPart < 10 Then
Select Case intPart
Case 1: strDollars = strDollars & " One"
Case 2: strDollars = strDollars & " Two"
Case 3: strDollars = strDollars & " Three"
Case 4: strDollars = strDollars & " Four"
Case 5: strDollars = strDollars & " Five"
Case 6: strDollars = strDollars & " Six"
Case 7: strDollars = strDollars & " Seven"
Case 8: strDollars = strDollars & " Eight"
Case 9: strDollars = strDollars & " Nine"
End Select
GoTo ConstructString
End If
End If

Select Case Right(intPart, 2)
Case 1: strDollars = strDollars & " One"
Case 2: strDollars = strDollars & " Two"
Case 3: strDollars = strDollars & " Three"
Case 4: strDollars = strDollars & " Four"
Case 5: strDollars = strDollars & " Five"
Case 6: strDollars = strDollars & " Six"
Case 7: strDollars = strDollars & " Seven"
Case 8: strDollars = strDollars & " Eight"
Case 9: strDollars = strDollars & " Nine"
Case 10: strDollars = strDollars & " Ten"
Case 11: strDollars = strDollars & " Eleven"
Case 12: strDollars = strDollars & " Twelve"
Case 13: strDollars = strDollars & " Thirteen"
Case 14: strDollars = strDollars & " Fourteen"
Case 15: strDollars = strDollars & " Fifteen"
Case 16: strDollars = strDollars & " Sixteen"
Case 17: strDollars = strDollars & " Seventeen"
Case 18: strDollars = strDollars & " Eighteen"
Case 19: strDollars = strDollars & " Nineteen"
Case 20: strDollars = strDollars & " Twenty"
Case 21: strDollars = strDollars & " Twenty One"
Case 22: strDollars = strDollars & " Twenty Two"
Case 23: strDollars = strDollars & " Twenty Three"
Case 24: strDollars = strDollars & " Twenty Four"
Case 25: strDollars = strDollars & " Twenty Five"
Case 26: strDollars = strDollars & " Twenty Six"
Case 27: strDollars = strDollars & " Twenty Seven"
Case 28: strDollars = strDollars & " Twenty Eight"
Case 29: strDollars = strDollars & " Twenty Nine"
Case 30: strDollars = strDollars & " Thirty"
Case 31: strDollars = strDollars & " Thirty One"
Case 32: strDollars = strDollars & " Thirty Two"
Case 33: strDollars = strDollars & " Thirty Three"
Case 34: strDollars = strDollars & " Thirty Four"
Case 35: strDollars = strDollars & " Thirty Five"
Case 36: strDollars = strDollars & " Thirty Six"
Case 37: strDollars = strDollars & " Thirty Seven"
Case 38: strDollars = strDollars & " Thirty Eight"
Case 39: strDollars = strDollars & " Thirty Nine"
Case 40: strDollars = strDollars & " Forty"
Case 41: strDollars = strDollars & " Forty One"
Case 42: strDollars = strDollars & " Forty Two"
Case 43: strDollars = strDollars & " Forty Three"
Case 44: strDollars = strDollars & " Forty Four"
Case 45: strDollars = strDollars & " Forty Five"
Case 46: strDollars = strDollars & " Forty Six"
Case 47: strDollars = strDollars & " Forty Seven"
Case 48: strDollars = strDollars & " Forty Eight"
Case 49: strDollars = strDollars & " Forty Nine"
Case 50: strDollars = strDollars & " Fifty"
Case 51: strDollars = strDollars & " Fifty One"
Case 52: strDollars = strDollars & " Fifty Two"
Case 53: strDollars = strDollars & " Fifty Three"
Case 54: strDollars = strDollars & " Fifty Four"
Case 55: strDollars = strDollars & " Fifty Five"
Case 56: strDollars = strDollars & " Fifty Six"
Case 57: strDollars = strDollars & " Fifty Seven"
Case 58: strDollars = strDollars & " Fifty Eight"
Case 59: strDollars = strDollars & " Fifty Nine"
Case 60: strDollars = strDollars & " Sixty"
Case 61: strDollars = strDollars & " Sixty One"
Case 62: strDollars = strDollars & " Sixty Two"
Case 63: strDollars = strDollars & " Sixty Three"
Case 64: strDollars = strDollars & " Sixty Four"
Case 65: strDollars = strDollars & " Sixty Five"
Case 66: strDollars = strDollars & " Sixty Six"
Case 67: strDollars = strDollars & " Sixty Seven"
Case 68: strDollars = strDollars & " Sixty Eight"
Case 69: strDollars = strDollars & " Sixty Nine"
Case 70: strDollars = strDollars & " Seventy"
Case 71: strDollars = strDollars & " Seventy One"
Case 72: strDollars = strDollars & " Seventy Two"
Case 73: strDollars = strDollars & " Seventy Three"
Case 74: strDollars = strDollars & " Seventy Four"
Case 75: strDollars = strDollars & " Seventy Five"
Case 76: strDollars = strDollars & " Seventy Six"
Case 77: strDollars = strDollars & " Seventy Seven"
Case 78: strDollars = strDollars & " Seventy Eight"
Case 79: strDollars = strDollars & " Seventy Nine"
Case 80: strDollars = strDollars & " Eighty"
Case 81: strDollars = strDollars & " Eighty One"
Case 82: strDollars = strDollars & " Eighty Two"
Case 83: strDollars = strDollars & " Eighty Three"
Case 84: strDollars = strDollars & " Eighty Four"
Case 85: strDollars = strDollars & " Eighty Five"
Case 86: strDollars = strDollars & " Eighty Six"
Case 87: strDollars = strDollars & " Eighty Seven"
Case 88: strDollars = strDollars & " Eighty Eight"
Case 89: strDollars = strDollars & " Eighty Nine"
Case 90: strDollars = strDollars & " Ninety"
Case 91: strDollars = strDollars & " Ninety One"
Case 92: strDollars = strDollars & " Ninety Two"
Case 93: strDollars = strDollars & " Ninety Three"
Case 94: strDollars = strDollars & " Ninety Four"
Case 95: strDollars = strDollars & " Ninety Five"
Case 96: strDollars = strDollars & " Ninety Six"
Case 97: strDollars = strDollars & " Ninety Seven"
Case 98: strDollars = strDollars & " Ninety Eight"
Case 99: strDollars = strDollars & " Ninety Nine"
End Select

ConstructString:
Select Case strPart
Case "cents"
GetDollarString = strDollars & " Cents"
Case "hundreds"
GetDollarString = strDollars
Case "thousands"
GetDollarString = strDollars & " Thousand"
Case "millions"
GetDollarString = strDollars & " Million"
Case "billions"
GetDollarString = strDollars & " Billion"
End Select
End Function
 
The problem is in this line near the top of the function:

cents = Right(dblValue, 2)

Replace it with
cents = (dblValue - Fix(dblValue)) * 100


The Right() function converts dblValue to string first then takes the right most two characters. The value of 100.10 is converted to a string like "100.1"

The suggested replacement gets the cents by manipulating the value as follows

(100.10 - 100) * 100 = 10

The Fix() function truncates the value leaving only the integer portion.
 
Status
Not open for further replies.

Part and Inventory Search

Sponsor

Back
Top