Instantly share code, notes, and snippets.

shabbirbhimani/SpellNumberEDP2.vb

Created February 6, 2021 11:47
Show Gist options
• Save shabbirbhimani/83e6063bb33977a89b7e4bb76b5ee655 to your computer and use it in GitHub Desktop.
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters. Learn more about bidirectional Unicode characters
 Option Explicit 'Main Function www.ExcelDataPro.com Function SpellNumberEDP2(ByVal MyNumber, Optional MyCurrency As String = "") Dim Dollars, Cents, Temp Dim DecimalPlace, Count, x ReDim Place(9) As String Place(2) = " Thousand " Place(3) = " Lacs " Place(4) = " Crores " Place(5) = " Hundred Crores " ' String representation of amount. MyNumber = Trim(Str(MyNumber)) ' Position of decimal place 0 if none. DecimalPlace = InStr(MyNumber, ".") ' Convert cents and set MyNumber to dollar amount. If DecimalPlace > 0 Then Cents = GetTens(Left(Mid(MyNumber, DecimalPlace + 1) & _ "00", 2)) MyNumber = Trim(Left(MyNumber, DecimalPlace - 1)) End If Count = 1 Do While MyNumber <> "" If Count = 1 Then x = 3 Else x = 2 End If Temp = GetHundreds(Right(MyNumber, x)) If Temp <> "" Then Dollars = Temp & Place(Count) & Dollars If Len(MyNumber) > x Then MyNumber = Left(MyNumber, Len(MyNumber) - x) Else MyNumber = "" End If Count = Count + 1 Loop Dim str_amount, str_amounts Dim str_cent, str_cents Select Case UCase(MyCurrency) Case "INR" str_amount = "Rupee" str_amounts = "Rupees" str_cent = "Paisa" str_cents = "Paisas" Case "PKR" str_amount = "Rupee" str_amounts = "Rupees" str_cent = "Paisa" str_cents = "Paisas" Case "BDT" str_amount = "Taka" str_amounts = "Takas" str_cent = "Poysha" str_cents = "Poysha" End Select Select Case Dollars Case "" Dollars = "No " & str_amounts Case "One" Dollars = "One " & str_amount Case Else Dollars = Dollars & " " & str_amounts End Select Select Case Cents Case "" Cents = " and No " & str_cents Case "One" Cents = " and One " & str_cent Case Else Cents = " and " & Cents & " " & str_cents End Select SpellNumberEDP2 = 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