کاربری
کاربر گرامی به خوش آمدید . اگر این نخستین بازدید شما از سایت است , لطفا ثبت نام کنید:

   

جهت تبلیغات در پرشین فروم کلیک کنید

نمایش نتایج: از شماره 1 تا 2 , از مجموع 2

موضوع: آموزش اکسس (بخش دوم)

  1. #1

    پیش فرض آموزش اکسس (بخش دوم)

    آموزش اکسس (بخش دوم)
    تابع تبديل عدد به حروف
    مقدمه :
    در اين يادداشت تابع مربوط به تبديل عدد به معادل حروفي آن ارائه مي كنم . عمدتا در سيستم هاي مالي و حسابداري نياز است معادل حروفي اعداد هم نمايش داده شده يا چاپ شوند كه توابع زير اين نياز را پاسخ مي دهد. مثلا براي چاپ يك چك روي خود برگه چك ، علاوه بر نياز به چاپ مبلغ عددي چك لازمست تا مبلغ حروفي چك هم روي برگه چاپ شود.

    نحوه استفاده از تابع :
    تابع Adad كه در زير ارائه شده است يك عدد را بعنوان ورودي گرفته و معادل حروفي آن عدد در زبان فارسي را بعنوان خروجي توليد مي كند. مثلا (Adad(1373 مقدار"يكهزار و سيصد و هفتاد و سه" را بعنوان خروجي توليد مي كند.براي استفاده از اين توابع بايد از چند خط پايين تر (Start of Module) تا انتهاي اين يادداشت را در حافظه كپي (Copy) كرده و در يك ماجول جديد در اكسس يا VB ، Paste كنيد . ( توجه داشته باشيد كه نمايش كدهاي نوشته شده در اينجا راست به چپ است كه پس از كپي كردن آن در ماجول اكسس بشكل صحيح نمايش داده خواهد شد)



    ' *********** Start of Module ***********

    'توابع تبديل عدد به معادل حروفي آن در زبان فارسي
    'برنامه نويس : حميد آزادي اردكاني
    'ويرايش اول : ارديبهشت 1380
    ' پست الكترونيك :
    ایمیل:
    لینک و متن درون کدها فقط برای کسانی که ثبت نام کرده اند قابل مشاهده است لطفا وارد شوید OR ثبت نام کنید.

    ' آدرس وب :
    Link URL:
    لینک و متن درون کدها فقط برای کسانی که ثبت نام کرده اند قابل مشاهده است لطفا وارد شوید OR ثبت نام کنید.


    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

  2. 4 کاربر برای این پست سودمند از Ahmadreza Jafari عزیز تشکر کرده اند:


  3. Left Ad Image/Code 1 needs to be placed here, no larger than 260 pixels in height.
    Right Ad Image/Code 2 needs to be placed here, no larger than 260 pixels in height.
  4. #2

    پیش فرض

    salam.motevejeh nashodam koja pastesh konam,,,yani ye file access baz konam

اطلاعات موضوع

کاربرانی که در حال مشاهده این موضوع هستند

در حال حاضر 1 کاربر در حال مشاهده این موضوع است. (0 کاربران و 1 مهمان ها)

موضوعات مشابه

  1. گوگل از تجسس در جیمیل دانش‌آموزان عقب‌نشینی کرد
    توسط چنگیز در انجمن اخبار و تازه های دنیای کامپیوتر و تکنولوژی , نرم افزار
    پاسخ ها: 0
    آخرين نوشته: 02-05-14, 20:20
  2. آموزش اکسس (بخش چهارم)
    توسط Ahmadreza Jafari در انجمن Microsoft Office Access
    پاسخ ها: 1
    آخرين نوشته: 09-10-09, 17:12
  3. آموزش اکسس (بخش ششم)
    توسط Ahmadreza Jafari در انجمن Microsoft Office Access
    پاسخ ها: 1
    آخرين نوشته: 17-03-09, 17:39
  4. آموزش اکسس (بخش اول)
    توسط Ahmadreza Jafari در انجمن Microsoft Office Access
    پاسخ ها: 0
    آخرين نوشته: 16-06-06, 04:50
  5. آموزش اکسس (بخش پنجم)
    توسط Ahmadreza Jafari در انجمن Microsoft Office Access
    پاسخ ها: 0
    آخرين نوشته: 16-06-06, 04:47

کلمات کلیدی این موضوع

علاقه مندی ها (Bookmarks)

علاقه مندی ها (Bookmarks)

مجوز های ارسال و ویرایش

  • شما نمیتوانید موضوع جدیدی ارسال کنید
  • شما امکان ارسال پاسخ را ندارید
  • شما نمیتوانید فایل پیوست کنید.
  • شما نمیتوانید پست های خود را ویرایش کنید
  •  
درباره ما

دوستان ما
لینک های مفید
ابزار ها
session بارگذاری مجدد کد امنیتی مندرج در تصویر را وارد کنید: