convert/write a number in words

Posted: 2002-06-01
By: ArchiveBot
Viewed: 63

Filed Under:

VB6 Code Cache

No attachments for this post

Takes any numerical value (less a billion) like "203463110" and outputs "Two Hundred Three Million Four Hundred Sixty Three Thousand One Hundred Ten"

Original Author: Noel Khan

Inputs

] Sub Translate(Number As String) [
The user/app send the translate sub some numerical value from a text or input box

Assumptions

Purpose:
was used to automate typing numerical values in words for stock certificates but can also be used in other financial apps (like an app that prints out information on checks).
'===============================================
Instalation:
cut and paste this code onto a form. Then hit F5

Returns

] NumberInText$ [
The sub return a string named "NumberInText$," which is the number worded out.

Side Effects

No side effects

Code

'*********************
'  DECLARATIONS
'*********************
Dim X As String   'the number input
Dim q As Long    'currently parsed-digit counter
Dim i As Long    'currently parsed 3-digit set, i.e., "000######", "###000###", etc
Dim NumberInText As String 'output, this is the translation of the numerical value
Dim BeginningInterval As Long  'counter to tract which 3-digit set the program is reading
Dim EndingInterval As Long   'counter to tract which 3-digit set the program is reading
Dim Temp As Variant 'temporary parse
'===============================================
Private Sub Translate(Number As String)

'INPUT: "NUMBER" PARAMETER,i.e., some numerical value
'OUTPUT: "NumberInText$" STRING, i.e., the number spelled out in words
'ASSUMES: input must be in 9-digit format, use the format function to ensure that it is
'REQUIRES: the following two related subs
    '1)HundredsPlaceOROnesPlace
    '2)TensPlace
    'and also the above declarations

'*********************
'  INITIALIZATION
'*********************
NumberInText$ = Empty
q = Empty
i = Empty
BeginningInterval = Empty
EndingInterval = Empty
Temp = Empty
'**********************
'   TRANSLATION
'**********************
  'the program reads the input in upto 3 sets (intervals) of 3 digits
  'at a time i.e., the millions, thousands, and hundreds
  For i = 1 To 3
    'the following counters keep track of which 3-digit set
    'the program is reading from
    BeginningInterval = EndingInterval + 1
    EndingInterval = EndingInterval + 3
      'now that the program has parsed upto three digits, its reads
      'and translates one digit at a time
      For q = BeginningInterval To EndingInterval
          'i use a temp variable to hold the single digit parse
          'if the parse is a zero, then skip on over to the next digit
          Temp = Mid(X$, q, 1): If Temp = "0" Then GoTo Escape
            'the next few lines essentially determines if the
            'suffix, "hundreds," is used and also determines
            'where to send the parse for translation.
            If q = 1 Xor q = 4 Xor q = 7 Then Call HundredsPlaceOROnesPlace: NumberInText$ = NumberInText$ & "Hundred "
            If q = 2 Xor q = 5 Xor q = 8 Then Call TensPlace
            If q = 3 Xor q = 6 Xor q = 9 Then Call HundredsPlaceOROnesPlace
Escape:
      Next q
    'the next couple lines essentially determines
    'if the suffix, million or thousand
    If EndingInterval = 3 And Not X$ Like "000######" Then NumberInText$ = NumberInText$ & "Million "
    If EndingInterval = 6 And Not X$ Like "###000###" Then NumberInText$ = NumberInText$ & "Thousand "
  Next i
End Sub
'===============================================
Private Sub HundredsPlaceOROnesPlace()
  Select Case Temp
    Case Is = "1": NumberInText$ = NumberInText$ & "One "
    Case Is = "2": NumberInText$ = NumberInText$ & "Two "
    Case Is = "3": NumberInText$ = NumberInText$ & "Three "
    Case Is = "4": NumberInText$ = NumberInText$ & "Four "
    Case Is = "5": NumberInText$ = NumberInText$ & "Five "
    Case Is = "6": NumberInText$ = NumberInText$ & "Six "
    Case Is = "7": NumberInText$ = NumberInText$ & "Seven "
    Case Is = "8": NumberInText$ = NumberInText$ & "Eight "
    Case Is = "9": NumberInText$ = NumberInText$ & "Nine "
    Case Else:
  End Select
End Sub
'===============================================
Private Sub TensPlace()
If Temp = 1 Then
  Temp = Mid(X$, q, 2)
    Select Case Temp
      Case Is = "10": NumberInText$ = NumberInText$ & "Ten ": q = q + 1
      Case Is = "11": NumberInText$ = NumberInText$ & "Eleven ": q = q + 1
      Case Is = "12": NumberInText$ = NumberInText$ & "Twelve ": q = q + 1
      Case Is = "13": NumberInText$ = NumberInText$ & "Thirteen ": q = q + 1
      Case Is = "14": NumberInText$ = NumberInText$ & "Fourteen ": q = q + 1
      Case Is = "15": NumberInText$ = NumberInText$ & "Fifteen ": q = q + 1
      Case Is = "16": NumberInText$ = NumberInText$ & "Sixteen ": q = q + 1
      Case Is = "17": NumberInText$ = NumberInText$ & "Seventeen ": q = q + 1
      Case Is = "18": NumberInText$ = NumberInText$ & "Eighteen ": q = q + 1
      Case Is = "19": NumberInText$ = NumberInText$ & "Nineteen ": q = q + 1
    End Select
Else
    Select Case Temp
      Case Is = "2": NumberInText$ = NumberInText$ & "Twenty "
      Case Is = "3": NumberInText$ = NumberInText$ & "Thirty "
      Case Is = "4": NumberInText$ = NumberInText$ & "Forty "
      Case Is = "5": NumberInText$ = NumberInText$ & "Fifty "
      Case Is = "6": NumberInText$ = NumberInText$ & "Sixty "
      Case Is = "7": NumberInText$ = NumberInText$ & "Seventy "
      Case Is = "8": NumberInText$ = NumberInText$ & "Eighty "
      Case Is = "9": NumberInText$ = NumberInText$ & "Ninety "
      Case Else
    End Select
End If
End Sub
'===============================================
Private Sub Form_Load()
Again:
  X$ = InputBox("Enter any number less than a billion." & vbCrLf & vbCrLf & "Type 'exit' to exit", "Number to Translate")
  
  If X$ = "exit" Then
    GoTo Exiting
  Else
    X$ = Format(X$, "000000000")  'input must be in nine digit format
    Call Translate(X$)
    MsgBox Format(X$, "###,###,###") & " = " & vbCrLf & vbCrLf & NumberInText$, vbOKOnly, "Translation"
    GoTo Again:
  End If
Exiting:
Unload Me
End Sub


Comments on this post

No comments have been added for this post.

You must be logged in to make a comment.