Advertisement
Guest User

Untitled

a guest
May 7th, 2019
90
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
  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.  
  12.     MyNumber = Trim(Str(MyNumber))
  13.     DecimalPlace = InStr(MyNumber, ".")
  14.     If DecimalPlace > 0 Then
  15.         Cents = GetTens(Left(Mid(MyNumber, DecimalPlace + 1) & _
  16.                   "00", 2))
  17.         MyNumber = Trim(Left(MyNumber, DecimalPlace - 1))
  18.     End If
  19.     Count = 1
  20.     Do While MyNumber <> ""
  21.         Temp = GetHundreds(Right(MyNumber, 3))
  22.         If Temp <> "" Then Dollars = Temp & Place(Count) & Dollars
  23.         If Len(MyNumber) > 3 Then
  24.             MyNumber = Left(MyNumber, Len(MyNumber) - 3)
  25.         Else
  26.             MyNumber = ""
  27.         End If
  28.         Count = Count + 1
  29.     Loop
  30.     Select Case Dollars
  31.         Case ""
  32.             Dollars = "No Dollars"
  33.         Case "One"
  34.             Dollars = "One Dollar"
  35.          Case Else
  36.             Dollars = Dollars & " Dollars"
  37.     End Select
  38.     Select Case Cents
  39.         Case ""
  40.             Cents = " and No Cents"
  41.         Case "One"
  42.             Cents = " and One Cent"
  43.               Case Else
  44.             Cents = " and " & Cents & " Cents"
  45.     End Select
  46.     SpellNumber = Dollars & Cents
  47. End Function
  48.  
  49. Function GetHundreds(ByVal MyNumber)
  50.     Dim Result As String
  51.     If Val(MyNumber) = 0 Then Exit Function
  52.     MyNumber = Right("000" & MyNumber, 3)
  53.     ' Convert the hundreds place.
  54.    If Mid(MyNumber, 1, 1) <> "0" Then
  55.         Result = GetDigit(Mid(MyNumber, 1, 1)) & " Hundred "
  56.     End If
  57.     ' Convert the tens and ones place.
  58.    If Mid(MyNumber, 2, 1) <> "0" Then
  59.         Result = Result & GetTens(Mid(MyNumber, 2))
  60.     Else
  61.         Result = Result & GetDigit(Mid(MyNumber, 3))
  62.     End If
  63.     GetHundreds = Result
  64. End Function
  65.  
  66. Function GetTens(TensText)
  67.     Dim Result As String
  68.     Result = "" ' Null out the temporary function value.
  69.    If Val(Left(TensText, 1)) = 1 Then   ' If value between 10-19...
  70.        Select Case Val(TensText)
  71.             Case 10: Result = "Ten"
  72.             Case 11: Result = "Eleven"
  73.             Case 12: Result = "Twelve"
  74.             Case 13: Result = "Thirteen"
  75.             Case 14: Result = "Fourteen"
  76.             Case 15: Result = "Fifteen"
  77.             Case 16: Result = "Sixteen"
  78.             Case 17: Result = "Seventeen"
  79.             Case 18: Result = "Eighteen"
  80.             Case 19: Result = "Nineteen"
  81.             Case Else
  82.         End Select
  83.     Else ' If value between 20-99...
  84.        Select Case Val(Left(TensText, 1))
  85.             Case 2: Result = "Twenty "
  86.             Case 3: Result = "Thirty "
  87.             Case 4: Result = "Forty "
  88.             Case 5: Result = "Fifty "
  89.             Case 6: Result = "Sixty "
  90.             Case 7: Result = "Seventy "
  91.             Case 8: Result = "Eighty "
  92.             Case 9: Result = "Ninety "
  93.             Case Else
  94.         End Select
  95.         Result = Result & GetDigit _
  96.             (Right(TensText, 1))  ' Retrieve ones place.
  97.    End If
  98.     GetTens = Result
  99. End Function
  100.  
  101. Function GetDigit(Digit)
  102.     Select Case Val(Digit)
  103.         Case 1: GetDigit = "One"
  104.         Case 2: GetDigit = "Two"
  105.         Case 3: GetDigit = "Three"
  106.         Case 4: GetDigit = "Four"
  107.         Case 5: GetDigit = "Five"
  108.         Case 6: GetDigit = "Six"
  109.         Case 7: GetDigit = "Seven"
  110.         Case 8: GetDigit = "Eight"
  111.         Case 9: GetDigit = "Nine"
  112.         Case Else: GetDigit = ""
  113.     End Select
  114. End Function
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement