Convert Number (Amount, Currency) to Words, Using by cheque layouts

Manuel Grenacher

Public Function ConvertAmountToWords(ByVal MyNumber As Double, Currency As String) As String
  Dim Temp As String
  Dim Dollars, Cents As String
  Dim DecimalPlace, Count As Integer
  Dim Place(9) As String
  Dim Numb As String
  
  Dim CurrName As String = LD.QueryData("SELECT CurrName FROM OCRN WHERE CurrCode = '"& Currency  &"'")
  Dim Chk100Name As String = LD.QueryData("SELECT Chk100Name FROM OCRN WHERE CurrCode = '"& Currency  &"'")
  Dim Result As String 
  
  Place(2) = " Thousand " : Place(3) = " Million " : Place(4) = " Billion " : Place(5) = " Trillion "
  ' Convert Numb to a string, trimming extra spaces.
  Numb = Trim(Str(MyNumber))
  ' Find decimal place.
  DecimalPlace = InStr(Numb, ".")
  ' If we find decimal place...
  If DecimalPlace > 0 Then
    ' Convert cents
    Temp = Left(Mid(Numb, DecimalPlace + 1) & "00", 2)
    Cents = ConvertTens(Temp)
    ' Strip off cents from remainder to convert.
    Numb = Trim(Left(Numb, DecimalPlace - 1))
  End If
  Count = 1
  Do While Numb <> ""
    ' Convert last 3 digits of Numb to English dollars.
    Temp = ConvertHundreds(Right(Numb, 3))
    If Temp <> "" Then Dollars = Temp & Place(Count) & Dollars
    If Len(Numb) > 3 Then
      ' Remove last 3 converted digits from Numb.
      Numb = Left(Numb, Len(Numb) - 3)
    Else
      Numb = ""
    End If
    Count = Count + 1
  Loop

  ' Clean up dollars.
  Select Case Dollars
    Case "" : Dollars = "No Dollars"
    Case "One" : Dollars = "One Dollar"
    Case Else : Dollars = Dollars & " Dollars"
  End Select

  ' Clean up cents.
  Select Case Cents
    Case "" : Cents = " And No Cents"
    Case "One" : Cents = " And One Cent"
    Case Else : Cents = " And " & Cents & " Cents"
  End Select
  Result = Dollars & Cents
  Result = Result.Replace("Dollar",currName)
  Result = Result.Replace("Cent",Chk100Name)
  Return Result  
End Function

Private Function ConvertHundreds(ByVal MyNumber As String) As String
  Dim Result As String
  ' Exit if there is nothing to convert.
  If Val(MyNumber) = 0 Then Exit Function
  ' Append leading zeros to number.
  MyNumber = Right("000" & MyNumber, 3)
  ' Do we have a hundreds place digit to convert?
  If Left(MyNumber, 1) <> "0" Then
    Result = ConvertDigit(Left(MyNumber, 1)) & " Hundred "
  End If
  ' Do we have a tens place digit to convert?
  If Mid(MyNumber, 2, 1) <> "0" Then
    Result = Result & ConvertTens(Mid(MyNumber, 2))
  Else
    ' If not, then convert the ones place digit.
    Result = Result & ConvertDigit(Mid(MyNumber, 3))
  End If
  ConvertHundreds = Trim(Result)
End Function

Private Function ConvertTens(ByVal MyTens As String) As String
  Dim Result As String
  ' Is value between 10 and 19?
  If Val(Left(MyTens, 1)) = 1 Then
    Select Case Val(MyTens)
      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
    ' .. otherwise it's between 20 and 99.
    Select Case Val(Left(MyTens, 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
    ' Convert ones place digit.
    Result = Result & ConvertDigit(Right(MyTens, 1))
  End If
  ConvertTens = Result
End Function

Private Function ConvertDigit(ByVal MyDigit As String) As String
  Select Case Val(MyDigit)
    Case 1 : ConvertDigit = "One"
    Case 2 : ConvertDigit = "Two"
    Case 3 : ConvertDigit = "Three"
    Case 4 : ConvertDigit = "Four"
    Case 5 : ConvertDigit = "Five"
    Case 6 : ConvertDigit = "Six"
    Case 7 : ConvertDigit = "Seven"
    Case 8 : ConvertDigit = "Eight"
    Case 9 : ConvertDigit = "Nine"
    Case Else : ConvertDigit = ""
  End Select
End Function