oobird

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

½Æ»s¥N½X