پشتیبانی: 09131253620
ارتباط با ما
تلگرام: 09131253620

برجسته ترین ها
گروه های مقاله ها
HyperLink


تبدیل عدد به حروف فارسی و انگلیسی در اکسس تاریخ درج: ١٣٩۶/٠۴/١٨

تبدیل عدد به حروف فارسی و انگلیسی در Microsoft Access به فایل اکسس قابل دانلود

گاهی اوقات لازم است که در برنامه اکسس اعداد را به حروف تبدیل کنید. به عنوان مثال ممکن است نیاز داشته باشید عدد 4251 به صورت چهار هزار و دویست و پنجاه و یک تبدیل کرده و نمایش دهید. برای این منظور میتوانید از دو فانکشن زیر برای تبدیل عدد به حروف استفاده کنید. یک از مجموع توابع برای تبدیل عدد به حروف فارسی و یکی دیگر از مجموع توابع برای تبدیل عدد به حروف انگلیسی می باشد.

متد تبدیل اعداد به حروف و رشته فارسی در برنامه Microsoft Access:

 

Function Adad(ByVal Number As Double) As String

   If Number = 0 Then

      Adad = "صفر"

   End If 

Dim Flag As Boolean

Dim S As String

Dim I, L As Byte

Dim K(1 To 5) As Double


S = Trim(Str(Number))

L = Len(S)

If L > 15 Then

Adad = "بسیار بزرگ"

Exit Function

End If

For I = 1 To 15 - L

S = "0" & S

Next I

For I = 1 To Int((L / 3) + 0.99)

K(5 - I + 1) = Val(Mid(S, 3 * (5 - I) + 1, 3))

Next I

Flag = False

S = ""

For I = 1 To 5

If K(I) <> 0 Then

Select Case I

Case 1

S = S & Three(K(I)) & " تریلیون"

Flag = True

Case 2

S = S & IIf(Flag = True, " و ", "") & Three(K(I)) & " میلیارد"

Flag = True

Case 3

S = S & IIf(Flag = True, " و ", "") & Three(K(I)) & " میلیون"

Flag = True

Case 4

S = S & IIf(Flag = True, " و ", "") & Three(K(I)) & " هزار"

Flag = True

Case 5

S = S & IIf(Flag = True, " و ", "") & Three(K(I))

End Select

End If

Next I

Adad = S

End Function



Function Three(ByVal Number As Integer) As String

Dim S As String

Dim I, L As Long

Dim h(1 To 3) As Byte

Dim Flag As Boolean

L = Len(Trim(Str(Number)))

If Number = 0 Then

Three = ""

Exit Function

End If

If Number = 100 Then

Three = "یکصد"

Exit Function

End If


If L = 2 Then h(1) = 0

If L = 1 Then

h(1) = 0

h(2) = 0

End If


For I = 1 To L

h(3 - I + 1) = Mid(Trim(Str(Number)), L - I + 1, 1)

Next I


Select Case h(1)

Case 1

S = "یکصد"

Case 2

S = "دویست"

Case 3

S = "سیصد"

Case 4

S = "چهارصد"

Case 5

S = "پانصد"

Case 6

S = "ششصد"

Case 7

S = "هفتصد"

Case 8

S = "هشتصد"

Case 9

S = "نهصد"

End Select


Select Case h(2)

Case 1

Select Case h(3)

Case 0

S = S & " و " & "ده"

Case 1

S = S & " و " & "یازده"

Case 2

S = S & " و " & "دوازده"

Case 3

S = S & " و " & "سیزده"

Case 4

S = S & " و " & "چهارده"

Case 5

S = S & " و " & "پانزده"

Case 6

S = S & " و " & "شانزده"

Case 7

S = S & " و " & "هفده"

Case 8

S = S & " و " & "هجده"

Case 9

S = S & " و " & "نوزده"

End Select


Case 2

S = S & " و " & "بیست"

Case 3

S = S & " و " & "سی"

Case 4

S = S & " و " & "چهل"

Case 5

S = S & " و " & "پنجاه"

Case 6

S = S & " و " & "شصت"

Case 7

S = S & " و " & "هفتاد"

Case 8

S = S & " و " & "هشتاد"

Case 9

S = S & " و " & "نود"

End Select


If h(2) <> 1 Then

Select Case h(3)

Case 1

S = S & " و " & "یک"

Case 2

S = S & " و " & "دو"

Case 3

S = S & " و " & "سه"

Case 4

S = S & " و " & "چهار"

Case 5

S = S & " و " & "پنج"

Case 6

S = S & " و " & "شش"

Case 7

S = S & " و " & "هفت"

Case 8

S = S & " و " & "هشت"

Case 9

S = S & " و " & "نه"

End Select

End If

S = IIf(L < 3, Right(S, Len(S) - 3), S)

Three = S

End Function

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

Public Function wsiSpellNumber(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 "

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

        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

    wsiSpellNumber = 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

 

 

مثال اجرا شده در اکسس (شکل زیر)

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

 

لینک دانلود پروژه (Download Link)

نکته: اگر در هنگام اجرای پروژه با پیغام  Security Warning مواجه شدین بر روی Enable Contetnt کلیک کنین. در غیر اینصورت ممکنه در پروژه دانلود شده متدها عملکرد خودشون رو به درستی انجام ندهند. (شکل زیر)

Enabled Content

 

 


تگها: number to word in access   تبدیل عدد به حروف   عدد به حرف در اکسس   عدد به حروف انگلیسی در اکسس   عدد به حروف در اکسس   عدد به حروف فارسی در اکسس   
 

HyperLink

ارسال نظر در مورد این مطلب
نام :  
آدرس ایمیل :  
متن پیام :  
کد امنیتی :  
   
   
نظری برای نمایش وجود ندارد
 
این مطلب را به اشتراک بگذارید: