如何使用 VBA 将数值转换为 Excel 中的孟加拉国货币

Question

enter image description here

Please see the image:

https://support.microsoft.com/en-us/help/213360/how-to-convert-a-numeric-value-into-english-words-in-excel

Answer 1

This may be more than you bargained for, but that may be better than if it were less. Try it. But first, please understand the setup. The idea is that you have a cell - in a worksheet, of course - in which you enter an amount. Then you have another cell - presumed to be on the same worksheet, but not necessarily so - in which to display the amount in words. Paste the calling procedure which follows here in the code sheet of the worksheet on which you have the cell to contain the amount.

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)

    Const AmountCell As String = "B5"           ' read the amount from here
    Const TargetCell As String = "D5"           ' write the words here
    Const Indian As Boolean = True

    If Target.Address = Range(AmountCell).Address Then
        Call WriteAmountInWords(Target.Value, Range(TargetCell), Indian)
    End If
End Sub

This code has a lot parameters you can set. They start in the above procedure. The amount will be written in cell B5. You can specify any other cell. You can add code to specify several cells. If you want the same action on another sheet you need to paste a copy of the code in that other sheet's code sheet as well.

The above code specifies the words to be written to cell D5. You can specify any other cell implicitly or relative to the AmountCell. That is another task of programming not covered here.

Finally, you can specify Indian as either True or False. If you specify it as True you get lakhs and crores. False will produce millions and billions. If such is your need you can set this property programmatically, too. Note, however, that the present structure doesn't lend itself to dynamic changes. You would have to replace the constants with variables.

The above code call the procedure WriteAmountInWords which has a lot of supporting code it needs. All of that must be on a new, normal (not class and not form) code module. Its name isn't important, but you might call it SpellNum . Paste all of the following code in that module.

Option Explicit
Option Base 0

Enum Ncr                        ' Index to Array Curr()
    NcrCurr
    NcrOnly                     ' word used when there are no cents
    NcrAnd                      ' word used between dollars and cents
    NcrFraction
End Enum

Enum Nct                        ' CaseType
    NctLower                    ' = all lower case
    NctFirst                    ' = Only first character in upper case
    NctProper                   ' = Each word's first character capitalised (Default)
    NctUpper                    ' = all caps
End Enum

Enum Ngp                        ' Number groups: Powers of 1000
    NgpN
    NgpM                        ' = 1000's
    NgpMM                       ' = millions
    NgpBn                       ' = billions
    NgpDec                      ' decimals
End Enum

    Const SpellCurr As String = "dollar,only,and,cent"
    Const Ones As String = "zero one two three four five six seven eight nine"
    Const Teens As String = "teen eleven twelve thir four fif six seven eigh nine"
    Const Tens As String = "null ten twenty thirty fourty fifty sixty seventy eighty ninety"
    Const Powers_En As String = "hundred thousand million billion"
    Const Powers_In As String = "hundred thousand lakh crore"
    Dim Powers As String

Public Sub WriteAmountInWords(ByVal Amt As Variant, _
                              ByRef TargetCell As Range, _
                              ByVal Indian As Boolean)

    Const WithCurr As Boolean = False
    Const NoDecs As Boolean = False
    Const SpellDecs As Boolean = False
    Const CaseType As Long = NctProper

    TargetCell.Value = SpellAmount(Amt, Indian, WithCurr, NoDecs, SpellDecs, CaseType)
End Sub

Private Function SpellAmount(ByVal Amt As Variant, _
                             ByVal Indian As Boolean, _
                             ByVal WithCurr As Boolean, _
                             ByVal NoDecs As Boolean, _
                             ByVal SpellDecs As Boolean, _
                             ByVal CaseType As Long) As String

    ' return the amount Amt in words
    ' include the currency, if WithCurr = True
    ' True to suppress zero fractions in integers,
      ' also ignore fractions existing in Amt
    ' write out fractions, if SpellDecs = True
    ' specify any Nct value for CaseType (Proper by default)

    Dim Num As Double                   ' = Amt
    Dim Spa As String                   ' result
    Dim S As String                     ' partial result
    Dim Sp() As String                  ' groups of numbers
    Dim G As Ngp

    Powers = IIf(Indian, Powers_In, Powers_En)
    Num = SetGroups(Amt, Sp, Indian)
    For G = NgpBn To NgpN Step -1
        If Val(Sp(G)) > 0 Then
            S = Spell999(Sp(G))
            If G > NgpN Then
                S = WithBreak(S, True) & Split(Powers)(G)
            End If
            Spa = WithBreak(Spa, True) & S
        End If
    Next G
    If Len(Spa) = 0 Then Spa = Split(Ones)(0)

    If NoDecs Then
        If WithCurr Then Call AddCurrency(Spa, Int(Num))
    Else
        Call AddDecimals(Spa, Sp(NgpDec), SpellDecs, WithCurr, Num)
    End If

    SpellAmount = WriteProper(Spa, CaseType)
End Function

Private Function Spell999(G3 As String) As String
    ' return the amount in words of a G3 of 3 numbers

    Dim Sp As String                    ' result
    Dim S As String                     ' partial result
    Dim n(1 To 3) As Integer            ' value of each character
    Dim IsTeen As Boolean
    Dim i As Long

    For i = 1 To 3
        n(i) = Val(Mid(Right("000" & G3, 3), i, 1))
    Next i
    If n(1) > 0 Then Sp = WithBreak((Split(Ones)(n(1)))) & _
                          Split(Powers)(NgpN)

    If n(2) = 1 And n(3) > 0 Then
        IsTeen = True
    ElseIf n(2) Then
        Sp = WithBreak(Sp) & Split(Tens)(n(2))
    End If

    If n(3) Then
        If IsTeen Then
            S = Split(Teens)(n(3))
            If n(3) > 2 Then
                S = WithBreak(S) & Split(Teens)(0)
            End If
        Else
            S = Split(Ones)(n(3))
        End If
        Sp = WithBreak(Sp) & S
    End If
    Spell999 = Sp
End Function

Private Sub AddDecimals(ByRef Spa As String, _
                        ByVal Decs As String, _
                        ByVal SpellDecs As Boolean, _
                        ByVal WithCurr As Boolean, _
                        ByVal Num As Double)
    Dim S As String

    If WithCurr And SpellDecs Then Call AddCurrency(S, Int(Num))
    S = WithBreak(S, True) & Split(SpellCurr, ",") _
                                  (NcrOnly - CBool(Val(Decs)))
    If SpellDecs Then
        If Val(Decs) Then
            S = WithBreak(S, True) & Spell999(Decs)
            If WithCurr Then
                Call AddCurrency(S, Val(Decs), True)
            Else
                S = WithBreak(S, True) & Split(Powers)(0) & "th"
            End If
        End If
    Else
        S = WithBreak(S, True) & Decs & "/100"
        If WithCurr Then Call AddCurrency(S, Num)
    End If
    Spa = WithBreak(Spa, True) & S
End Sub

Private Function SetGroups(ByVal Amt As Variant, _
                           ByRef Sp() As String, _
                           ByVal Indian As Boolean) As Double
    ' Sp() is a return array

    Dim Grps() As Variant
    Dim A As String
    Dim n As Integer
    Dim i As Integer

    If Indian Then
        Grps = Array(5, 2, 2, 3)            ' from left to right
    Else
        Grps = Array(3, 3, 3, 3)
    End If
    ReDim Sp(NgpDec)

    A = Format(Unformat(Amt), String(12, "0") & ".00")
    For i = NgpN To (NgpDec - 1)
        Sp(NgpDec - i - 1) = Mid(A, n + 1, Grps(i))
        n = n + Grps(i)
    Next i
    Sp(NgpDec) = Right(A, 2)
    SetGroups = Val(A)
End Function

Private Function Unformat(ByVal Amt As Variant) As String

    Dim Uf As String
    Dim S As String
    Dim i As Integer

    For i = 1 To Len(Amt)
        S = Mid(Amt, i, 1)
        If IsNumeric(S) Or S = "." Then
            Uf = Uf & S
        End If
    Next i
    Unformat = Uf
End Function

Private Function WithBreak(ByVal S As String, _
                           Optional ByVal AddSpace As Boolean) _
                           As String
    ' append a conditional line break or space to S

    Dim BreakChar As Integer

    BreakChar = IIf(AddSpace, 32, 31)
    WithBreak = S
    If Len(S) > 1 Then
        If Asc(Right(S, 1)) <> BreakChar Then
            WithBreak = S + Chr(BreakChar)
        End If
    End If
End Function

Private Function WriteProper(ByVal S As String, _
                             ByVal CaseType As Nct) As String

    Dim Wp As String
    Dim Sp() As String
    Dim n As Long

    If Len(S) Then
        Wp = LCase(S)
        Select Case CaseType
            Case NctFirst
                Wp = UCase(Left(S, 1)) & Mid(S, 2)
            Case NctProper
                Sp = Split(Wp)
                For n = LBound(Sp) To UBound(Sp)
                    Sp(n) = UCase(Left(Sp(n), 1)) & Mid(Sp(n), 2)
                Next n
                Wp = Join(Sp)
            Case NctUpper
                Wp = UCase(S)
        End Select
    End If
    WriteProper = Wp
End Function

Private Sub AddCurrency(ByRef Spa As String, _
                        ByVal Num As Double, _
                        Optional IsFraction As Boolean)
    Dim S As String
    Dim i As Ncr

    i = IIf(IsFraction, NcrFraction, NcrCurr)
    S = Split(SpellCurr, ",")(i) & IIf(Num = 1, "", "s")
    Spa = WithBreak(Spa, True) & S
End Sub

Look for this line of code Const SpellCurr As String = "dollar,only,and,cent" . Change the dollars to the name of your currency. Same for the "cents". However, by default the words will be written without naming the currency. You have to enable that by changing Const WithCurr As Boolean = False to True .

This setting excludes decimals from the written amount. Const NoDecs As Boolean = False . You can change it to True . Once it is True you can specify how to write the decimals, in words or numbers. Const SpellDecs As Boolean = False The default is False, meaning written as numbers, like 00/100.

The last constant in the WriteAmountInWords procedure determines capitalisation of the spelled out amount. Const CaseType As Long = NctProper . To set this constant, use one of the enumerations at the top of the code (here repeated).

Enum Nct                        ' CaseType
    NctLower                    ' = all lower case
    NctFirst                    ' = Only first character in upper case
    NctProper                   ' = Each word's first character capitalised (Default)
    NctUpper                    ' = all caps
End Enum

Note that the capitalisation of the enuration names will adapt itself to your preference. Once you capitalise a name differently, VBA will remember and follow your guidance. Type responsibly.

Answer 2

I have updated the module for bangla. I have done it for my personal need. Now you can use too. Below is the download link. Right click and select save as.

https://github.com/masudpce/number_to_bangla_word/raw/main/number_to_bangla%20_word_any_font.bas