Draft

From CleanPosts

(Difference between revisions)
Jump to: navigation, search
(Replaced content with " Dim iArr As Variant Dim i As Integer Dim r As Integer Dim temp As Integer Application.Volatile ReDim iArr(Bottom To Top) For i = Bottom To Top iA…")
Line 1: Line 1:
 +
  Dim iArr As Variant
-
      Function SpellNumber(ByVal MyNumber)
+
  Dim i As Integer
-
          Dim Dollars, Cents, Temp
+
  Dim r As Integer
-
          Dim DecimalPlace, Count
+
  Dim temp As Integer
 +
  Application.Volatile
-
          ReDim Place(9) As String
 
-
          Place(2) = " Thousand "
+
  ReDim iArr(Bottom To Top)
-
          Place(3) = " Million "
+
  For i = Bottom To Top
-
          Place(4) = " Billion "
+
      iArr(i) = i
-
          Place(5) = " Trillion "
+
  Next i
 +
  For i = Top To Bottom + 1 Step -1
-
          ' String representation of amount.
+
      r = Int(Rnd() * (i - Bottom + 1)) + Bottom
-
          MyNumber = Trim(Str(MyNumber))
+
      temp = iArr(r)
 +
      iArr(r) = iArr(i)
 +
      iArr(i) = temp
-
          ' Position of decimal place 0 if none.
+
  Next i
-
          DecimalPlace = InStr(MyNumber, ".")
 
-
          ' Convert cents and set MyNumber to dollar amount.
+
  For i = Bottom To Bottom + Amount - 1
-
          If DecimalPlace > 0 Then
+
      RandLotto = RandLotto & " " & iArr(i)
-
              Cents = GetTens(Left(Mid(MyNumber, DecimalPlace + 1) & _
+
  Next i
-
                  "00", 2))
 
-
              MyNumber = Trim(Left(MyNumber, DecimalPlace - 1))
+
  RandLotto = Trim(RandLotto)
-
 
+
-
          End If
+
-
 
+
-
 
+
-
 
+
-
          Count = 1
+
-
 
+
-
          Do While MyNumber <> ""
+
-
 
+
-
              Temp = GetHundreds(Right(MyNumber, 3))
+
-
 
+
-
              If Temp <> "" Then Dollars = Temp & Place(Count) & Dollars
+
-
 
+
-
              If Len(MyNumber) > 3 Then
+
-
 
+
-
                  MyNumber = Left(MyNumber, Len(MyNumber) - 3)
+
-
 
+
-
              Else
+
-
 
+
-
                  MyNumber = ""
+
-
 
+
-
              End If
+
-
 
+
-
              Count = Count + 1
+
-
 
+
-
          Loop
+
-
 
+
-
 
+
-
 
+
-
          Select Case Dollars
+
-
 
+
-
              Case ""
+
-
 
+
-
                  Dollars = "No Dollars"
+
-
 
+
-
              Case "One"
+
-
 
+
-
                  Dollars = "One Dollar"
+
-
 
+
-
              Case Else
+
-
 
+
-
                  Dollars = Dollars & " Dollars"
+
-
 
+
-
          End Select
+
-
 
+
-
 
+
-
 
+
-
          Select Case Cents
+
-
 
+
-
              Case ""
+
-
 
+
-
                  Cents = " and No Cents"
+
-
 
+
-
              Case "One"
+
-
 
+
-
                  Cents = " and One Cent"
+
-
 
+
-
              Case Else
+
-
 
+
-
                  Cents = " and " & Cents & " Cents"
+
-
 
+
-
          End Select
+
-
 
+
-
 
+
-
 
+
-
          SpellNumber = Dollars & Cents
+
-
 
+
-
      End Function
+
-
 
+
-
 
+
-
 
+
-
 
+
-
 
+
-
 
+
-
 
+
-
      '*******************************************
+
-
 
+
-
      ' Converts a number from 100-999 into text *
+
-
 
+
-
      '*******************************************
+
-
 
+
-
 
+
-
 
+
-
      Function GetHundreds(ByVal MyNumber)
+
-
 
+
-
          Dim Result As String
+
-
 
+
-
 
+
-
 
+
-
          If Val(MyNumber) = 0 Then Exit Function
+
-
 
+
-
          MyNumber = Right("000" & MyNumber, 3)
+
-
 
+
-
 
+
-
 
+
-
          ' Convert the hundreds place.
+
-
 
+
-
          If Mid(MyNumber, 1, 1) <> "0" Then
+
-
 
+
-
              Result = GetDigit(Mid(MyNumber, 1, 1)) & " Hundred "
+
-
 
+
-
          End If
+
-
 
+
-
 
+
-
 
+
-
          ' Convert the tens and ones place.
+
-
 
+
-
          If Mid(MyNumber, 2, 1) <> "0" Then
+
-
 
+
-
              Result = Result & GetTens(Mid(MyNumber, 2))
+
-
 
+
-
          Else
+
-
 
+
-
              Result = Result & GetDigit(Mid(MyNumber, 3))
+
-
 
+
-
          End If
+
-
 
+
-
 
+
-
 
+
-
          GetHundreds = Result
+
-
 
+
-
      End Function
+
-
 
+
-
 
+
-
 
+
-
 
+
-
 
+
-
 
+
-
 
+
-
      '*********************************************
+
-
 
+
-
      ' Converts a number from 10 to 99 into text. *
+
-
 
+
-
      '*********************************************
+
-
 
+
-
 
+
-
 
+
-
    Function GetTens(TensText)
+
-
 
+
-
          Dim Result As String
+
-
 
+
-
 
+
-
 
+
-
          Result = ""          ' Null out the temporary function value.
+
-
 
+
-
          If Val(Left(TensText, 1)) = 1 Then  ' If value between 10-19...
+
-
 
+
-
              Select Case Val(TensText)
+
-
 
+
-
                  Case 10: Result = "Ten"
+
-
 
+
-
                  Case 11: Result = "Eleven"
+
-
 
+
-
                  Case 12: Result = "Twelve"
+
-
 
+
-
                  Case 13: Result = "Thirteen"
+
-
 
+
-
                  Case 14: Result = "Fourteen"
+
-
 
+
-
                  Case 15: Result = "Fifteen"
+
-
 
+
-
                  Case 16: Result = "Sixteen"
+
-
 
+
-
                  Case 17: Result = "Seventeen"
+
-
 
+
-
                  Case 18: Result = "Eighteen"
+
-
 
+
-
                  Case 19: Result = "Nineteen"
+
-
 
+
-
                  Case Else
+
-
 
+
-
              End Select
+
-
 
+
-
          Else                                ' If value between 20-99...
+
-
 
+
-
              Select Case Val(Left(TensText, 1))
+
-
 
+
-
                  Case 2: Result = "Twenty "
+
-
 
+
-
                  Case 3: Result = "Thirty "
+
-
 
+
-
                  Case 4: Result = "Forty "
+
-
 
+
-
                  Case 5: Result = "Fifty "
+
-
 
+
-
                  Case 6: Result = "Sixty "
+
-
 
+
-
                  Case 7: Result = "Seventy "
+
-
 
+
-
                  Case 8: Result = "Eighty "
+
-
 
+
-
                  Case 9: Result = "Ninety "
+
-
 
+
-
                  Case Else
+
-
 
+
-
              End Select
+
-
 
+
-
              Result = Result & GetDigit _
+
-
 
+
-
                  (Right(TensText, 1))  ' Retrieve ones place.
+
-
 
+
-
          End If
+
-
 
+
-
          GetTens = Result
+
-
 
+
-
      End Function
+
-
 
+
-
 
+
-
 
+
-
 
+
-
 
+
-
 
+
-
 
+
-
 
+
-
 
+
-
      '*******************************************
+
-
 
+
-
      ' Converts a number from 1 to 9 into text. *
+
-
 
+
-
      '*******************************************
+
-
 
+
-
 
+
-
 
+
-
      Function GetDigit(Digit)
+
-
 
+
-
          Select Case Val(Digit)
+
-
 
+
-
              Case 1: GetDigit = "One"
+
-
 
+
-
              Case 2: GetDigit = "Two"
+
-
 
+
-
              Case 3: GetDigit = "Three"
+
-
 
+
-
              Case 4: GetDigit = "Four"
+
-
 
+
-
              Case 5: GetDigit = "Five"
+
-
 
+
-
              Case 6: GetDigit = "Six"
+
-
 
+
-
              Case 7: GetDigit = "Seven"
+
-
 
+
-
              Case 8: GetDigit = "Eight"
+
-
 
+
-
              Case 9: GetDigit = "Nine"
+
-
 
+
-
              Case Else: GetDigit = ""
+
-
 
+
-
          End Select
+
-
 
+
-
      End Function
+

Revision as of 17:18, 7 April 2019

 Dim iArr As Variant
 Dim i As Integer
 Dim r As Integer
 Dim temp As Integer


 Application.Volatile


 ReDim iArr(Bottom To Top)
 For i = Bottom To Top
     iArr(i) = i
 Next i


 For i = Top To Bottom + 1 Step -1
     r = Int(Rnd() * (i - Bottom + 1)) + Bottom
     temp = iArr(r)
     iArr(r) = iArr(i)
     iArr(i) = temp
 Next i


 For i = Bottom To Bottom + Amount - 1
     RandLotto = RandLotto & " " & iArr(i)
 Next i


 RandLotto = Trim(RandLotto)
Personal tools
Strangers In Paradise
Terminal Cruise