Convert Number to Word English (Visual Basic – VBA)

After you’ve completed the code below you use: ConNumToEnglish(102)=One Hundred and two.
'----------------------------------------------
'the project is about converting number to word
'the word is in english language
'----------------------------------------------
'Created by: Mr. Iech Setha
'Created date: 13-Oct-2003

Public Function ConNumToEnglish(ByVal pNum As Variant) As String
    'Error Handling
    'On Error GoTo ErrHandler
    'variable declaration
    Dim PostNum As Long 'use for position of character in a string
    Dim SignNum As String   'use for sign of number (-) or (+)
   
   
    'convert only number not null string
    If pNum & "" <> "" Then
        '
        'get sign of number whether (-) or (+)
        If Left(pNum, 1) = "-" Then
            'if sign of number is negative (-)
            pNum = Right(pNum, Len(pNum) - 1)
            'convert sign (-) to letter as "negative"
            'store the word "negative" in variable SignNum,
            'otherwise SignNum is Null
            SignNum = "(Negative) "
        End If
      
        'convert the parameter to decimal data type
        'decimal: +/-79,228,162,514,264,337,593,543,950,335,
        'with 28 decimal places
        pNum = CDec(pNum): pNum = CStr(pNum)
        '
        'find the position of point if the number is not Fix
        PostNum = InStr(1, pNum, ".", vbBinaryCompare)
       
        'if the decimal point is found
        If PostNum <> 0 Then
            'convert number on the both sides of decimal point
            'then join the converted two numbers with word "point" in the middle
            ConNumToEnglish = CallConvert(Left(pNum, PostNum - 1)) & _
                              " point " & _
                              CallConvert(Right(pNum, Len(pNum) - PostNum), "AF")
        Else
            'if the number is not include decimal point,
            'just convert only one number
            ConNumToEnglish = CallConvert(pNum)
        End If
        '
        'after we convert number to word already
        'then convert then first word with One letter on left to Upper Case
        ConNumToEnglish = UCase(Left(ConNumToEnglish, 1)) & _
                          Right(ConNumToEnglish, Len(ConNumToEnglish) - 1)
        'combine the word with sign word if include (negative)
        ConNumToEnglish = SignNum & ConNumToEnglish
      End If
      '
      Exit Function
      '
      'label
ErrHandler:
    MsgBox Err.Description, vbExclamation
End Function

Private Function ConvertNumber(ByVal pNum As String) As String
    'error handling
    'On Error GoTo ErrHandler
    '
    'variables
    Dim MyOneNum, MyTwoNum  'MyOneNum: Word for one number,
                            'MyTwoNum: Word for two numbers
    Dim strHun As String    'strHun: Hundred
    Dim FixLen As Integer   'FixLen: get len of number to be converted to word
       
    'word stand for one number
    MyTwoNum = Array("", "", "twenty", "thirty", _
                     "fourty", "fifty", _
                     "sixty", "seventy", _
                     "eighty", "ninety")
    '
    'word stand for two numbers
    MyOneNum = Array("", "one", "two", "three", _
                    "four", "five", "six", _
                    "seven", "eight", "nine", _
                    "ten", "eleven", "twelve", _
                    "thirteen", "fourteen", "fifteen", _
                    "sixteen", "seventeen", "eighteen", "nineteen")
       
    'get length of number
    FixLen = GetFixLen(pNum)
    If pNum & "" = "" Then pNum = "0"
    'discuss on length of number to get its word
    Select Case FixLen
        Case 2: strHun = "hundred"
        Case 3: strHun = "thousand"
        Case 6: strHun = "million"
        Case 9: strHun = "billion"
        Case Else: strHun = ""
    End Select
   
    'if it is in plural form
    If FixLen <> 0 Then
        'join the word with "s" at last of statement
        If Len(pNum) >= 3 And _
           CDec(Left(pNum, Len(pNum) - FixLen)) > 1 Then _
           strHun = strHun & "s"
    End If
   
    'if num lenght is more than 2
    If FixLen > 0 Then
        'convert now
        ConvertNumber = ConvertNumber(Left(pNum, Len(pNum) - FixLen)) & _
                       " " & strHun
        '
        'if there are many word for number
        'then join them with ", "
        If CLng(Len(pNum)) > FixLen + 1 Or _
           (CLng(Len(pNum)) = FixLen + 1 And _
           CLng(Right(pNum, FixLen)) <> 0) Then
            'convert the remain number on the right
            'and join the already converted with ", "
            'call function as recursive function
            ConvertNumber = ConvertNumber & ", " & _
                            ConvertNumber(Right(pNum, FixLen))
        End If
      
    'if number is between 20 to 99
    Else
        '
        If CLng(pNum) >= 20 Then
            ConvertNumber = MyTwoNum(CInt(Left(pNum, 1))) & _
                            " " & ConvertNumber(Right(pNum, 1))
        Else
            'if number is less than 20
            ConvertNumber = MyOneNum(CInt(pNum))
        End If
    End If
   
    'if the end of string is ", " then cut it out
    If Right(ConvertNumber, 2) = ", " Then
        ConvertNumber = Left(ConvertNumber, Len(ConvertNumber) - 2)
    End If
    '
    Exit Function
    '
ErrHandler:
    MsgBox Err.Description, vbExclamation
End Function

Private Function CallConvert(ByVal pNum As String, Optional pBAP As String) As String
    'error handling
    'On Error GoTo ErrHandler
    'variable for position
    Dim PostNum As Integer
   
    '
    If CInt(Left(pNum, 1)) = 0 And pBAP = "AF" Then
        'if the number on the right side of decimal point
        'join 1 to number as temporary and then cut it away
        'join 1 for convert the number after decimal point
        pNum = "1" & Right(pNum, Len(pNum) - 1)
       
        If Len(pNum) = 2 Then
            CallConvert = "zero " & ConvertNumber(Right(pNum, 1))
        Else
            'convert number
            CallConvert = ConvertNumber(pNum)
            'cut the first three letter (one) as join before
            CallConvert = "zero " & Right(CallConvert, _
                          Len(CallConvert) - 3)
        End If
    Else
        'convert normal number
        CallConvert = ConvertNumber(pNum)
        'if null then convert it to zero
        If CallConvert = "" Then CallConvert = "zero"
    End If
    '
    'find the last position of "," in the string of words
    PostNum = MyInStr(Len(CallConvert), CallConvert, ",")
    '
    'if found the "," position then
    'replace it with the word " and" for english grammar
    If PostNum <> 0 Then _
        CallConvert = Left(CallConvert, PostNum - 1) & _
                      " and" & Right(CallConvert, _
                      Len(CallConvert) - PostNum)
    '
    Exit Function
    '
ErrHandler:
    MsgBox Err.Description, vbExclamation
End Function

Private Function GetFixLen(ByRef pNum As String) As Integer
    'error handling
    'On Error GoTo ErrHandler
   
    Dim FixLen As Integer   'store len of number
   
    'length of number is has the same word for many number
    'just change its header
    'for example: 1000--one thousand, and 10000---one hundred thousand and so on
    'so length of numbers are different but has some words the same
    Select Case Len(pNum)
        Case 4 To 6: FixLen = 3     'thousand
        Case 3: FixLen = 2          'hundred
        Case 7 To 9: FixLen = 6     'million
        Case Is > 9: FixLen = 9     'billion
        Case Else:    FixLen = 0
    End Select
    '
    'if the left number of number is zero then skip it
    If pNum & "" <> "" Then
        If CDec(Left(pNum, Len(pNum) - FixLen)) = 0 Then
            'get the remain right number
            pNum = Right(pNum, FixLen)
            'get length again if not include zero at the left most
            FixLen = GetFixLen(pNum)
        End If
    End If
    '
    GetFixLen = FixLen
   
    '
    Exit Function
    '
ErrHandler:
    MsgBox Err.Description, vbExclamation
End Function

Public Function MyInStr(pStop As Long, Str1 As String, Str2 As String) As Long
   If Len(Str2) <= Len(Str1) Then
    Dim i As Long, wsCount As Long
    Dim FindI As Boolean: FindI = False
    For i = pStop To 1 Step -1
        wsCount = wsCount + 1
        If Mid(Str1, i - Len(Str2) + 1, Len(Str2)) = CStr(Str2) Then
            FindI = True
            Exit For
        End If
    Next i
    If FindI = True Then MyInStr = pStop - wsCount + 1
  Else
    MsgBox "The length of string one must longer than string two.", vbInformation, "Information..."
  End If
End Function

Coded by: Mr. Setha IECH

One Response to “Convert Number to Word English (Visual Basic – VBA)”

  1. khemraloan Says:

    តើមានកូដរាប់ជាអក្សរខ្មែរទេ?


Leave a Reply

Fill in your details below or click an icon to log in:

WordPress.com Logo

You are commenting using your WordPress.com account. Log Out / Change )

Twitter picture

You are commenting using your Twitter account. Log Out / Change )

Facebook photo

You are commenting using your Facebook account. Log Out / Change )

Google+ photo

You are commenting using your Google+ account. Log Out / Change )

Connecting to %s

%d bloggers like this: