1. Option Explicit
2. 'Main Function
3. Function SpellNumber(ByVal MyNumber)
4. Dim Dollars, Cents, Temp
5. Dim DecimalPlace, Count
6. ReDim Place(9) As String
7. Place(2) = " Thousand "
8. Place(3) = " Million "
9. Place(4) = " Billion "
10. Place(5) = " Trillion "
11. ' String representation of amount.
12. MyNumber = Trim(Str(MyNumber))
13. ' Position of decimal place 0 if none.
14. DecimalPlace = InStr(MyNumber, ".")
15. ' Convert cents and set MyNumber to dollar amount.
16. If DecimalPlace > 0 Then
17. Cents = GetTens(Left(Mid(MyNumber, DecimalPlace + 1) & _
18. "00", 2))
19. MyNumber = Trim(Left(MyNumber, DecimalPlace - 1))
20. End If
21. Count = 1
22. Do While MyNumber <> ""
23. Temp = GetHundreds(Right(MyNumber, 3))
24. If Temp <> "" Then Dollars = Temp & Place(Count) & Dollars
25. If Len(MyNumber) > 3 Then
26. MyNumber = Left(MyNumber, Len(MyNumber) - 3)
27. Else
28. MyNumber = ""
29. End If
30. Count = Count + 1
31. Loop
32. Select Case Dollars
33. Case ""
34. Dollars = "No Dollars"
35. Case "One"
36. Dollars = "One Dollar"
37. Case Else
38. Dollars = Dollars & " Dollars"
39. End Select
40. Select Case Cents
41. Case ""
42. Cents = " and No Cents"
43. Case "One"
44. Cents = " and One Cent"
45. Case Else
46. Cents = " and " & Cents & " Cents"
47. End Select
48. SpellNumber = Dollars & Cents
49. End Function
50.
51. ' Converts a number from 100-999 into text
52. Function GetHundreds(ByVal MyNumber)
53. Dim Result As String
54. If Val(MyNumber) = 0 Then Exit Function
55. MyNumber = Right("000" & MyNumber, 3)
56. ' Convert the hundreds place.
57. If Mid(MyNumber, 1, 1) <> "0" Then
58. Result = GetDigit(Mid(MyNumber, 1, 1)) & " Hundred "
59. End If
60. ' Convert the tens and ones place.
61. If Mid(MyNumber, 2, 1) <> "0" Then
62. Result = Result & GetTens(Mid(MyNumber, 2))
63. Else
64. Result = Result & GetDigit(Mid(MyNumber, 3))
65. End If
66. GetHundreds = Result
67. End Function
68.
69. ' Converts a number from 10 to 99 into text.
70. Function GetTens(TensText)
71. Dim Result As String
72. Result = "" ' Null out the temporary function value.
73. If Val(Left(TensText, 1)) = 1 Then ' If value between 10-19...
74. Select Case Val(TensText)
75. Case 10: Result = "Ten"
76. Case 11: Result = "Eleven"
77. Case 12: Result = "Twelve"
78. Case 13: Result = "Thirteen"
79. Case 14: Result = "Fourteen"
80. Case 15: Result = "Fifteen"
81. Case 16: Result = "Sixteen"
82. Case 17: Result = "Seventeen"
83. Case 18: Result = "Eighteen"
84. Case 19: Result = "Nineteen"
85. Case Else
86. End Select
87. Else ' If value between 20-99...
88. Select Case Val(Left(TensText, 1))
89. Case 2: Result = "Twenty "
90. Case 3: Result = "Thirty "
91. Case 4: Result = "Forty "
92. Case 5: Result = "Fifty "
93. Case 6: Result = "Sixty "
94. Case 7: Result = "Seventy "
95. Case 8: Result = "Eighty "
96. Case 9: Result = "Ninety "
97. Case Else
98. End Select
99. Result = Result & GetDigit _
100. (Right(TensText, 1)) ' Retrieve ones place.
101. End If
102. GetTens = Result
103. End Function
104.
105. ' Converts a number from 1 to 9 into text.
106. Function GetDigit(Digit)
107. Select Case Val(Digit)
108. Case 1: GetDigit = "One"
109. Case 2: GetDigit = "Two"
110. Case 3: GetDigit = "Three"
111. Case 4: GetDigit = "Four"
112. Case 5: GetDigit = "Five"
113. Case 6: GetDigit = "Six"
114. Case 7: GetDigit = "Seven"
115. Case 8: GetDigit = "Eight"
116. Case 9: GetDigit = "Nine"
117. Case Else: GetDigit = ""
118. End Select
119. End Function
No comments:
Post a Comment