Convert Numeric Currency into Text

Category:
Forms and Controls
Type:
Modules
Difficulty:
Intermediate

Author: Anonymous

Version Compatibility: Visual Basic 6

More information:
Here is a program that converts numeric currency into it's textual equivalent. Be sure to keep the declarations in a separate module, or change the scope declarations to Private.

Instructions: Copy the declarations and code below and paste directly into your VB project.

Declarations:

Code:'THIS PROGRAM IS BASED ON THE CONCEPT OF RECURSIVE PROGRAMMING' 'IT REUSES THE SAME FUNCTIONS A NUMBER OF TIMES' 'DEVELOPED BY JANWADKAR SACHIN PRABHAKAR' Private Sub Command1_Click() APOINT = "" BPOINT = "" If IsNumeric(Text1.Text) = False Then MsgBox "ENTER A PROPER NUMERIC VALUE (IN RS & PAISE)" + vbCrLf + "BETWEEN ONE PAISE TO 99 CRORERS", vbCritical Exit Sub End If Text1.Text = VBA.Round(Text1.Text, 2) If Len(Text1.Text) > 2 Then If VBA.Mid(Text1.Text, Len(Text1.Text) - 1, 1) = "." Then Text1.Text = Text1.Text + "0" End If End If T2 = VBA.Int(Val(Text1.Text)) If VBA.InStr(1, Text1.Text, ".") = 0 Then Text1.Text = Text1.Text + ".00" End If '----------------FOR CALCULATING PAISE-----------------------' If Len(T2) = 1 Then T1 = Mid(Text1.Text, Len(Text1.Text) - 1, 2) APT = Right(T1, 2) APOINT = AFTERPOINT(APT) T2 = VBA.Int(Text1.Text) BPT = Right(T2, 1) BPOINT = BEFOREPOINT(BPT) End If '----------------FOR CALCULATING RS(UPTO 99)-----------------------' If Len(T2) = 2 Then T1 = Mid(Text1.Text, Len(Text1.Text) - 1, 2) APT = Right(T1, 2) APOINT = AFTERPOINT(APT) T2 = VBA.Int(Text1.Text) BPT = Right(T2, 2) BPOINT = BEFOREPOINT(BPT) End If '----------------FOR CALCULATING RS(100 TO 999)-----------------------' If Len(T2) = 3 Then T1 = Mid(Text1.Text, Len(Text1.Text) - 1, 2) APT = Right(T1, 2) APOINT = AFTERPOINT(APT) BPT = Left(T2, 1) BPOINT = BEFOREPOINT(BPT) BPOINT1 = BPOINT + " HUNDRED " BPT = Val(Mid(T2, 2, 2)) BPOINT = BPOINT1 + BEFOREPOINT(BPT) End If '----------------FOR CALCULATING RS(1000 TO 9999)-----------------------' If Len(T2) = 4 Then T1 = Mid(Text1.Text, Len(Text1.Text) - 1, 2) APT = Right(T1, 2) APOINT = AFTERPOINT(APT) BPT = Left(T2, 1) BPOINT = BEFOREPOINT(BPT) THOU = BPOINT + " THOUSAND " BPT = Val(Mid(T2, 2, 1)) If BPT = 0 Then HUND = THOU Else BPOINT = BEFOREPOINT(BPT) HUND = THOU + BPOINT + " HUNDRED " End If BPT = Val(Mid(T2, 3, 2)) BPOINT = HUND + BEFOREPOINT(BPT) End If '----------------FOR CALCULATING RS(10000 TO 99999)-----------------------' If Len(T2) = 5 Then T1 = Mid(Text1.Text, Len(Text1.Text) - 1, 2) APT = Right(T1, 2) APOINT = AFTERPOINT(APT) BPT = Left(T2, 2) BPOINT = BEFOREPOINT(BPT) THOU = BPOINT + " THOUSAND " BPT = Val(Mid(T2, 3, 1)) If BPT = 0 Then HUND = THOU Else BPOINT = BEFOREPOINT(BPT) HUND = THOU + BPOINT + " HUNDRED " End If BPT = Val(Mid(T2, 4, 2)) BPOINT = HUND + BEFOREPOINT(BPT) End If '----------------FOR CALCULATING RS(100000 TO 999999)-----------------------' If Len(T2) = 6 Then T1 = Mid(Text1.Text, Len(Text1.Text) - 1, 2) APT = Right(T1, 2) APOINT = AFTERPOINT(APT) BPT = Left(T2, 1) BPOINT = BEFOREPOINT(BPT) LAKH = BPOINT + " LAKH " BPT = Val(Mid(T2, 2, 2)) BPOINT = BEFOREPOINT(BPT) If BPT = 0 Then THOU = LAKH Else BPOINT = BEFOREPOINT(BPT) THOU = LAKH + BPOINT + " THOUSAND " End If BPT = Val(Mid(T2, 4, 1)) If BPT = 0 Then HUND = THOU Else BPOINT = BEFOREPOINT(BPT) HUND = THOU + BPOINT + " HUNDRED " End If BPT = Val(Mid(T2, 5, 2)) BPOINT = HUND + BEFOREPOINT(BPT) End If '----------------FOR CALCULATING RS(1000000 TO 9999999)-----------------------' If Len(T2) = 7 Then T1 = Mid(Text1.Text, Len(Text1.Text) - 1, 2) APT = Right(T1, 2) APOINT = AFTERPOINT(APT) BPT = Left(T2, 2) BPOINT = BEFOREPOINT(BPT) LAKH = BPOINT + " LAKH " BPT = Val(Mid(T2, 3, 2)) BPOINT = BEFOREPOINT(BPT) If BPT = 0 Then THOU = LAKH Else BPOINT = BEFOREPOINT(BPT) THOU = LAKH + BPOINT + " THOUSAND " End If BPT = Val(Mid(T2, 5, 1)) If BPT = 0 Then HUND = THOU Else BPOINT = BEFOREPOINT(BPT) HUND = THOU + BPOINT + " HUNDRED " End If BPT = Val(Mid(T2, 6, 2)) BPOINT = HUND + BEFOREPOINT(BPT) End If '----------------FOR CALCULATING RS(10000000 TO 99999999)-----------------------' If Len(T2) = 8 Then T1 = Mid(Text1.Text, Len(Text1.Text) - 1, 2) APT = Right(T1, 2) APOINT = AFTERPOINT(APT) BPT = Left(T2, 1) BPOINT = BEFOREPOINT(BPT) CRORE = BPOINT + " CRORE " BPT = Val(Mid(T2, 2, 2)) BPOINT = BEFOREPOINT(BPT) If BPT = 0 Then LAKH = CRORE Else BPOINT = BEFOREPOINT(BPT) LAKH = CRORE + BPOINT + " LAKH " End If BPT = Val(Mid(T2, 4, 2)) BPOINT = BEFOREPOINT(BPT) If BPT = 0 Then THOU = LAKH Else BPOINT = BEFOREPOINT(BPT) THOU = LAKH + BPOINT + " THOUSAND " End If BPT = Val(Mid(T2, 6, 1)) If BPT = 0 Then HUND = THOU Else BPOINT = BEFOREPOINT(BPT) HUND = THOU + BPOINT + " HUNDRED " End If BPT = Val(Mid(T2, 7, 2)) BPOINT = HUND + BEFOREPOINT(BPT) End If '----------------FOR CALCULATING RS(100000000 TO 999999999)-----------------------' If Len(T2) = 9 Then T1 = Mid(Text1.Text, Len(Text1.Text) - 1, 2) APT = Right(T1, 2) APOINT = AFTERPOINT(APT) BPT = Left(T2, 2) BPOINT = BEFOREPOINT(BPT) CRORE = BPOINT + " CRORE " BPT = Val(Mid(T2, 3, 2)) BPOINT = BEFOREPOINT(BPT) If BPT = 0 Then LAKH = CRORE Else BPOINT = BEFOREPOINT(BPT) LAKH = CRORE + BPOINT + " LAKH " End If BPT = Val(Mid(T2, 5, 2)) BPOINT = BEFOREPOINT(BPT) If BPT = 0 Then THOU = LAKH Else BPOINT = BEFOREPOINT(BPT) THOU = LAKH + BPOINT + " THOUSAND " End If BPT = Val(Mid(T2, 7, 1)) If BPT = 0 Then HUND = THOU Else BPOINT = BEFOREPOINT(BPT) HUND = THOU + BPOINT + " HUNDRED " End If BPT = Val(Mid(T2, 8, 2)) BPOINT = HUND + BEFOREPOINT(BPT) End If '----------------FOR DISPLAYING RS INTO WORDS-----------------------' If BPOINT = "" Then L1 = APOINT Else If APOINT = "" Then L1 = " RS " + BPOINT Else L1 = " RS " + BPOINT + " AND " + APOINT End If End If If L1 = "" Then MsgBox "ENTER A PROPER NUMERIC VALUE (IN RS & PAISE) BETWEEN ONE PAISE TO 99 CRORER RUPEES", vbCritical Exit Sub Text1.SetFocus End If End Sub Public Function AFTERPOINT(X As String) As String If Left(X, 1) = 0 Then ANUM = Right(X, 1) Select Case ANUM Case "0" AFTERPOINT = "" Case "1" AFTERPOINT = " ONE " + " PAISE " Case "2" AFTERPOINT = " TWO " + " PAISE " Case "3" AFTERPOINT = " THREE " + " PAISE " Case "4" AFTERPOINT = " FOUR " + " PAISE " Case "5" AFTERPOINT = " FIVE " + " PAISE " Case "6" AFTERPOINT = " SIX " + " PAISE " Case "7" AFTERPOINT = " SEVEN " + " PAISE " Case "8" AFTERPOINT = " EIGHT " + " PAISE " Case "9" AFTERPOINT = " NINE " + " PAISE " End Select End If If Left(X, 1) = 1 Then ANUM = X Select Case ANUM Case "10" AFTERPOINT = " TEN " + " PAISE " Case "11" AFTERPOINT = " ELEVEN " + " PAISE " Case "12" AFTERPOINT = " TWELVE " + " PAISE " Case "13" AFTERPOINT = " THIRTEEN " + " PAISE " Case "14" AFTERPOINT = " FOURTEEN " + " PAISE " Case "15" AFTERPOINT = " FIFTEEN " + " PAISE " Case "16" AFTERPOINT = " SIXTEEN " + " PAISE " Case "17" AFTERPOINT = " SEVENTEEN " + " PAISE " Case "18" AFTERPOINT = " EIGHTEEN " + " PAISE " Case "19" AFTERPOINT = " NINETEEN " + " PAISE " End Select End If If Left(X, 1) = 2 Then ANUM = Right(X, 1) If ANUM = "0" Then AFTERPOINT = " TWENTY " + " PAISE" Else ACOMM = ACOMMON(NUM) AFTERPOINT = " TWENTY " + "" + ACOMM End If End If If Left(X, 1) = 3 Then ANUM = Right(X, 1) If ANUM = "0" Then AFTERPOINT = " THIRTY " + "PAISE" Else ACOMM = ACOMMON(NUM) AFTERPOINT = " THIRTY " + "" + ACOMM End If End If If Left(X, 1) = 4 Then ANUM = Right(X, 1) If ANUM = "0" Then AFTERPOINT = " FORTY " + "PAISE" Else ACOMM = ACOMMON(NUM) AFTERPOINT = " FORTY " + "" + ACOMM End If End If If Left(X, 1) = 5 Then ANUM = Right(X, 1) If ANUM = "0" Then AFTERPOINT = " FIFTY " + "PAISE" Else ACOMM = ACOMMON(NUM) AFTERPOINT = " FIFTY " + "" + ACOMM End If End If If Left(X, 1) = 6 Then ANUM = Right(X, 1) If ANUM = "0" Then AFTERPOINT = " SIXTY " + "PAISE" Else ACOMM = ACOMMON(NUM) AFTERPOINT = " SIXTY " + "" + ACOMM End If End If If Left(X, 1) = 7 Then ANUM = Right(X, 1) If ANUM = "0" Then AFTERPOINT = " SEVENTY " + "PAISE" Else ACOMM = ACOMMON(NUM) AFTERPOINT = " SEVENTY " + "" + ACOMM End If End If If Left(X, 1) = 8 Then ANUM = Right(X, 1) If ANUM = "0" Then AFTERPOINT = " EIGHTY " + "PAISE" Else ACOMM = ACOMMON(NUM) AFTERPOINT = " EIGHTY " + "" + ACOMM End If End If If Left(X, 1) = 9 Then ANUM = Right(X, 1) If ANUM = "0" Then AFTERPOINT = " NINTY " + "PAISE" Else ACOMM = ACOMMON(NUM) AFTERPOINT = " NINTY " + "" + ACOMM End If End If End Function Private Sub Command2_Click() End End Sub Private Sub Command3_Click() Text1.Text = "" Text1.SetFocus L1 = "" End Sub Private Sub Text1_KeyPress(KeyAscii As Integer) If KeyAscii = 13 Then VBA.SendKeys "{TAB}" End If End Sub Public Function ACOMMON(ACOM As String) As String Select Case ANUM Case "0" ACOMMON = "" Case "1" ACOMMON = " ONE " + " PAISE " Case "2" ACOMMON = " TWO " + " PAISE " Case "3" ACOMMON = " THREE " + " PAISE " Case "4" ACOMMON = " FOUR " + " PAISE " Case "5" ACOMMON = " FIVE " + " PAISE " Case "6" ACOMMON = " SIX " + " PAISE " Case "7" ACOMMON = " SEVEN " + " PAISE " Case "8" ACOMMON = " EIGHT " + " PAISE " Case "9" ACOMMON = " NINE " + " PAISE " End Select End Function Public Function BEFOREPOINT(X As String) As String If Len(X) = 1 Then BNUM = X Select Case BNUM Case "0" BEFOREPOINT = "" Case "1" BEFOREPOINT = " ONE " Case "2" BEFOREPOINT = " TWO " Case "3" BEFOREPOINT = " THREE " Case "4" BEFOREPOINT = " FOUR " Case "5" BEFOREPOINT = " FIVE " Case "6" BEFOREPOINT = " SIX " Case "7" BEFOREPOINT = " SEVEN " Case "8" BEFOREPOINT = " EIGHT " Case "9" BEFOREPOINT = " NINE " End Select Exit Function End If If Left(X, 1) = 1 Then BNUM = X Select Case BNUM Case "10" BEFOREPOINT = " TEN " Case "11" BEFOREPOINT = " ELEVEN " Case "12" BEFOREPOINT = " TWELVE " Case "13" BEFOREPOINT = " THIRTEEN " Case "14" BEFOREPOINT = " FOURTEEN " Case "15" BEFOREPOINT = " FIFTEEN " Case "16" BEFOREPOINT = " SIXTEEN " Case "17" BEFOREPOINT = " SEVENTEEN " Case "18" BEFOREPOINT = " EIGHTEEN " Case "19" BEFOREPOINT = " NINETEEN " End Select End If If Left(X, 1) = 2 Then BNUM = Right(X, 1) If BNUM = "0" Then BEFOREPOINT = " TWENTY " Else BCOMM = BCOMMON(NUM) BEFOREPOINT = " TWENTY " + BCOMM End If End If If Left(X, 1) = 3 Then BNUM = Right(X, 1) If BNUM = "0" Then BEFOREPOINT = " THIRTY " Else BCOMM = BCOMMON(NUM) BEFOREPOINT = " THIRTY " + BCOMM End If End If If Left(X, 1) = 4 Then BNUM = Right(X, 1) If BNUM = "0" Then BEFOREPOINT = " FORTY " Else BCOMM = BCOMMON(NUM) BEFOREPOINT = " FORTY " + BCOMM End If End If If Left(X, 1) = 5 Then BNUM = Right(X, 1) If BNUM = "0" Then BEFOREPOINT = " FIFTY " Else BCOMM = BCOMMON(NUM) BEFOREPOINT = " FIFTY " + BCOMM End If End If If Left(X, 1) = 6 Then BNUM = Right(X, 1) If BNUM = "0" Then BEFOREPOINT = " SIXTY " Else BCOMM = BCOMMON(NUM) BEFOREPOINT = " SIXTY " + BCOMM End If End If If Left(X, 1) = 7 Then BNUM = Right(X, 1) If BNUM = "0" Then BEFOREPOINT = " SEVENTY " Else BCOMM = BCOMMON(NUM) BEFOREPOINT = " SEVENTY " + BCOMM End If End If If Left(X, 1) = 8 Then BNUM = Right(X, 1) If BNUM = "0" Then BEFOREPOINT = " EIGHTY " Else BCOMM = BCOMMON(NUM) BEFOREPOINT = " EIGHTY " + BCOMM End If End If If Left(X, 1) = 9 Then BNUM = Right(X, 1) If BNUM = "0" Then BEFOREPOINT = " NINTY " Else BCOMM = BCOMMON(NUM) BEFOREPOINT = " NINTY " + BCOMM End If End If End Function Public Function BCOMMON(BCOM As String) As String Select Case BNUM Case "0" BCOMMON = "" Case "1" BCOMMON = " ONE " Case "2" BCOMMON = " TWO " Case "3" BCOMMON = " THREE " Case "4" BCOMMON = " FOUR " Case "5" BCOMMON = " FIVE " Case "6" BCOMMON = " SIX " Case "7" BCOMMON = " SEVEN " Case "8" BCOMMON = " EIGHT " Case "9" BCOMMON = " NINE " End Select End Function