VBA code to Convert Amount in numbers to Dirhams.

 ഈ ലേഖനത്തിൽ Excel 2019, 2016, 2013 എന്നിവയിലും മറ്റ് പതിപ്പുകളിലും കറൻസി നമ്പറുകളെ ഇംഗ്ലീഷ് പദങ്ങളാക്കി മാറ്റുന്നതിനുള്ള വേഗമേറിയതും സൗജന്യവുമായ രണ്ട് വഴികൾ ഞാൻ നിങ്ങൾക്ക് കാണിച്ചുതരാം.

 മൈക്രോസോഫ്റ്റ് എക്സൽ ഇതും അതും കണക്കാക്കാനുള്ള ഒരു മികച്ച പ്രോഗ്രാമാണ്. വലിയ ഡാറ്റ അറേകൾ പ്രോസസ്സ് ചെയ്യുന്നതിനാണ് ഇത് ആദ്യം വികസിപ്പിച്ചത്. എന്നിരുന്നാലും, ഇൻവോയ്‌സുകൾ, മൂല്യനിർണ്ണയം അല്ലെങ്കിൽ ബാലൻസ് ഷീറ്റുകൾ പോലുള്ള അക്കൗണ്ടിംഗ് റെക്കോർഡുകൾ വേഗത്തിലും ഫലപ്രദമായും സൃഷ്ടിക്കാനും ഇത് അനുവദിക്കുന്നു.

 കൂടുതലോ കുറവോ സോളിഡ് പേയ്‌മെന്റ് ഡോക്യുമെന്റുകളിൽ സംഖ്യാ മൂല്യങ്ങൾ അവയുടെ വാക്ക് ഫോം ഉപയോഗിച്ച് ഡ്യൂപ്ലിക്കേറ്റ് ചെയ്യേണ്ടത് ആവശ്യമാണ്. കൈകൊണ്ട് എഴുതുന്നതിനേക്കാൾ ടൈപ്പ് ചെയ്‌ത നമ്പറുകളിൽ കൃത്രിമം കാണിക്കുന്നത് വളരെ ബുദ്ധിമുട്ടാണ്. ചില തട്ടിപ്പുകാർക്ക് 3000 ൽ 8000 ഉണ്ടാക്കാൻ ശ്രമിക്കാം, അതേസമയം "മൂന്ന്" "എട്ട്" ഉപയോഗിച്ച് രഹസ്യമായി മാറ്റുന്നത് മിക്കവാറും അസാധ്യമാണ്.

 

SpellNumber VBA macro to convert numbers to words

ഞാൻ ഇതിനകം സൂചിപ്പിച്ചതുപോലെ, ഈ ടാസ്ക്കിനായി ഒരു ഉപകരണം ചേർക്കാൻ Microsoft ആഗ്രഹിച്ചില്ല. എന്നിരുന്നാലും, എത്ര ഉപയോക്താക്കൾക്ക് ഇത് ആവശ്യമാണെന്ന് കണ്ടപ്പോൾ, അവർ അവരുടെ വെബ്‌സൈറ്റിൽ പ്രത്യേക VBA മാക്രോ സൃഷ്‌ടിക്കുകയും പ്രസിദ്ധീകരിക്കുകയും ചെയ്തു. മാക്രോ അതിന്റെ പേര് SpellNumber സൂചിപ്പിക്കുന്നത് ചെയ്യുന്നു. ഞാൻ കണ്ട മറ്റെല്ലാ മാക്രോകളും Microsoft കോഡ് അടിസ്ഥാനമാക്കിയുള്ളതാണ്.

"സ്പെൽനമ്പർ ഫോർമുല" എന്ന് പരാമർശിച്ചിരിക്കുന്ന മാക്രോ നിങ്ങൾക്ക് കണ്ടെത്താം. എന്നിരുന്നാലും, ഇത് ഒരു ഫോർമുലയല്ല, ഒരു മാക്രോ ഫംഗ്‌ഷൻ അല്ലെങ്കിൽ കൂടുതൽ കൃത്യമായി പറഞ്ഞാൽ Excel User Defined Function (UDF)

സ്പെൽനമ്പർ ഓപ്ഷന് ദിർഹമുകളും ഫില്ലുകളും എഴുതാൻ കഴിയും. നിങ്ങൾക്ക് മറ്റൊരു കറൻസി ആവശ്യമുണ്ടെങ്കിൽ, നിങ്ങളുടെ പേരിനൊപ്പം "ഡോളർ", "സെന്റ്" എന്നിവ മാറ്റാം.

നിങ്ങൾ ഒരു VBA വിദഗ്ദ്ധനല്ലെങ്കിൽ, ചുവടെ നിങ്ങൾ കോഡിന്റെ ഒരു പകർപ്പ് കണ്ടെത്തും. ഇത് 

പരിഹരിക്കാൻ നിങ്ങൾക്ക് ഇപ്പോഴും താൽപ്പര്യമില്ലെങ്കിൽ അല്ലെങ്കിൽ സമയം ഇല്ലെങ്കിൽ, 

ദയവായി ഈ പരിഹാരം ഉപയോഗിക്കുക.

1.  നിങ്ങൾക്ക് അക്കങ്ങൾ എഴുതേണ്ട വർക്ക്ബുക്ക് തുറക്കുക.

2.  വിഷ്വൽ ബേസിക് എഡിറ്റർ വിൻഡോ തുറക്കാൻ Alt+F11 അമർത്തുക.

3. നിങ്ങൾക്ക് നിരവധി പുസ്‌തകങ്ങൾ തുറന്നിട്ടുണ്ടെങ്കിൽ, എഡിറ്ററിന്റെ മുകളിൽ ഇടത് കോണിലുള്ള 

പ്രോജക്‌റ്റുകളുടെ ലിസ്റ്റ് ഉപയോഗിച്ച് ആവശ്യമായ വർക്ക്‌ബുക്ക് സജീവമാണോയെന്ന് പരിശോധിക്കുക 

(വർക്ക്‌ബുക്ക് ഘടകങ്ങളിൽ ഒന്ന് നീല നിറത്തിൽ ഹൈലൈറ്റ് ചെയ്‌തിരിക്കുന്നു).

4. എഡിറ്റർ മെനുവിൽ Insert-> Module എന്നതിലേക്ക് പോകുക.

 5. YourBook - Module1 എന്ന പേരിലുള്ള ഒരു വിൻഡോ നിങ്ങൾ കാണും. ചുവടെയുള്ള ഫ്രെയിമിലെ എല്ലാ കോഡുകളും തിരഞ്ഞെടുത്ത് ഈ വിൻഡോയിൽ paste ചെയ്യുക.

6. Excel-ലേക്ക് തിരികെ പോകാൻ Alt+q അമർത്തുക

Option Explicit

'Main Function

Function SpellNumber(ByVal MyNumber)

        Dim Dollars, Cents, Temp

        Dim DecimalPlace, Count

        ReDim Place(9) As String

        Place(2) = " Thousand "

        Place(3) = " Million "

        Place(4) = " Billion "

        Place(5) = " Trillion "

 

        MyNumber = Trim(Str(MyNumber))

        DecimalPlace = InStr(MyNumber, ".")

        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 <> ""

                Temp = GetHundreds(Right(MyNumber, 3))

                If Temp <> "" Then Dollars = Temp & Place(Count) & Dollars

                If Len(MyNumber) > 3 Then

                        MyNumber = Left(MyNumber, Len(MyNumber) - 3)

                Else

                        MyNumber = ""

                End If

                Count = Count + 1

        Loop

        Select Case Dollars

                Case ""

                        Dollars = "No Dollars"

                Case "One"

                        Dollars = "One Dollar"

                 Case Else

                        Dollars = Dollars & " Dollars"

        End Select

        Select Case Cents

                Case ""

                        Cents = " and No Cents"

                Case "One"

                        Cents = " and One Cent"

                            Case Else

                        Cents = " and " & Cents & " Cents"

        End Select

        SpellNumber = Dollars & Cents

End Function

 

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

 

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

 

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