ماژول اکسس تبدیل اعداد به حروف انگلیسی

بسم الله الرحمن الرحیم

سلام

روند تبدیل و تغییر اطلاعات به یکدیگر یکی از کارهای ابتدایی یک برنامه نویس است.

در این آموزش قصد داریم تا به کمک یک ماژول، اعداد را تبدیل به حروف کرد؛ البته نه حروف فارسی! بلکه حروف انگلیسی.

پس اگر به دنبال ماژول تبدیل اعداد به حروف فارسی در اکسس هستید، سری به بخش ماژول‌های ما بزنید...

برای تبدیل اعداد به حروف انگلیسی این آموزش را دنبال کنید.

ابتدا وارد محیط کدنویسی VBA شوید و یک ماژول خام با نام SpellNumber ایجاد کنید و سپس محتویات زیر را در آن قرار دهید؛

Option Compare Database
Option Explicit

'*************************
' Main Function          *
'Access-Training.blog.ir *
'*************************
Function SpellNumber(ByVal MyNumber, _
Optional ByVal MyCurrency As String = "GBP") As String

Dim Pounds, Pence, Temp
Dim DecimalPlace, Count

ReDim Place(9) As String
Place(2) = " Thousand "
Place(3) = " Million "
Place(4) = " Billion "
Place(5) = " Trillion "

'Test for real value (number).
If Not IsNumeric(MyNumber) Then
    SpellNumber = "Not Valid!"
    Exit Function
End If

' 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
    Pence = 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 Pounds = Temp & Place(Count) & Pounds
    If Len(MyNumber) > 3 Then
        MyNumber = Left(MyNumber, Len(MyNumber) - 3)
    Else
        MyNumber = ""
    End If
    Count = Count + 1
Loop

Select Case Pounds
    Case ""
        Pounds = "No " & GetCurrencyNarrative(MyCurrency, True)
        Case "One"
        Pounds = "One " & Left(GetCurrencyNarrative(MyCurrency, True) _
            , Len(GetCurrencyNarrative(MyCurrency, True)) - 1)
    Case Else
        Pounds = Pounds & " " & GetCurrencyNarrative(MyCurrency, True)
End Select
    
Select Case Pence
    Case ""
        Pence = " and No " & GetCurrencyNarrative(MyCurrency, False)
    Case "One"
        Pence = " and One " & GetCurrencyNarrative(MyCurrency, False)
    Case Else
        Pence = " and " & Pence & " " & _
        GetCurrencyNarrative(MyCurrency, False)
End Select

SpellNumber = Pounds & Pence
End Function

'*******************************************
' Converts a number from 100-999 into text *
' Access-Training.blog.ir                  *
'*******************************************
Private 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. *
' Access-Training.blog.ir                    *
'*********************************************
Private 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. *
' Access-Training.blog.ir                  *
'*******************************************

Private 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

'********************************************
' Collects which currency narrative to show *
' Access-Training.blog.ir                   *
'********************************************

Private Function GetCurrencyNarrative(CountryCode As String, _
b As Boolean) As String
'b is a flag of TRUE or FALSE that returns either "Pounds" (TRUE)
'or "Pence" (FALSE) for GBP or "Dollars" or "Cents"
'based on the country code.

Select Case UCase(CountryCode)
    Case Is = "IRR"
        If b Then
            GetCurrencyNarrative = "Hezar"
        Else
            GetCurrencyNarrative = "Toman"
        End If
    Case Is = "GBP"
        If b Then
            GetCurrencyNarrative = "Pounds"
        Else
            GetCurrencyNarrative = "Pence"
        End If
    Case Is = "USD"
        If b Then
            GetCurrencyNarrative = "Dollars"
        Else
            GetCurrencyNarrative = "Cents"
        End If
    Case Is = "EUR"
        If b Then
            GetCurrencyNarrative = "Euros"
        Else
            GetCurrencyNarrative = "Cents"
        End If
    'Case Is = ""
    '[add your own currencies here to expand the choice...]

Case Else 'catch if the above is not working - default to...
    If b Then
        GetCurrencyNarrative = "Pounds"
    Else
        GetCurrencyNarrative = "Pence"
    End If
End Select
End Function

ماژول آماده است، آن را ذخیره و جهت اطمینان کامپایل هم کنید.

حالا شما می‌توانید علاوه در لابلای کدنویسی‌های خود، در کوئری و گزارشات هم از این ماژول استفاده کنید.

ساختار این ماژول از قرار زیر است:

• مثال استفاده در کوئری:

SpellNumber([Filed Name],”IRR”)