تقييم الموضوع :
  • 1 أصوات - بمعدل 5
  • 1
  • 2
  • 3
  • 4
  • 5
ممكن مساعدة .برمامج التفقيط للعملة الاردنية و برنامج طباعة الشيكات
#1
السلام عليكم ورحمة الله و بركاتة

احتاح لبرنامج التفقيط و طباعة الشيكات بالعملة الاردنية ان امكن ..وجزاكم الله خيرا يا ربي
Heartاحبكم في اللهHeart
http://www.vb4arb.com/vb4arb2.gif
الرد }}}}
تم الشكر بواسطة:
#2
.....

ملاحظة: ليتم نسخ الكود بمحتواه العربي سليماً يجب أن تكون لوحة المفاتيح على اللغة العربية قبل عملية النسخ.

منقول

طريقة استخدام دالة تحويل الرقم إلى نص مع إضافة اسم العملة وإضافة خاصية اختيار الكسر العشري الثلاثي
كود :
' عملة بكسر عشري ثنائي كالعملة الأردنية باستخدام القرش حيث يتكون الدينار من 100 قرش
Me.Text2.Text = NoToTxt(Val(Me.Text1.Text), "دينار", "قرش", False)
كود :
' عملة بكسر عشري ثلاثي كالعملة الأردنية باستخدام الفلس حيث يتكون الدينار من 1000 فلس
Me.Text2.Text = NoToTxt(Val(Me.Text1.Text), "دينار", "فلس", True)

دالة التحويل بعد تحسينها وإضافة خاصية اختيار الكسر العشري الثلاثي
ضع هذا الكود في موديول Module
كود :
Option Explicit

Public Function NoToTxt(ByVal TheNo As Double, ByVal MyCur As String, ByVal MySubCur As String, Optional ByVal Dec3Digit As Boolean = False) As String
    '======================
    If Dec3Digit Then
        If TheNo > 999999999999.999 Then
            NoToTxt = ""
            Exit Function
        End If
    Else
        If TheNo > 999999999999.99 Then
            NoToTxt = ""
            Exit Function
        End If
    End If
    '======================
    If TheNo = 0 Then
            NoToTxt = "صفر"
            Exit Function
        End If
    '======================

    Dim MyNo, GetNo, RdNo, GetTxt, ReMark As String
    Dim My100, My10, My1, My11, My12 As String
    Dim Mybillion, MyMillion As String
    Dim MyThou, MyHun, MyFraction As String
    Dim MyArry1(9) As String
    Dim MyArry2(9) As String
    Dim MyArry3(9) As String
    Dim MyAnd As String
    '======================
    MyAnd = " و"
    
    MyArry1(0) = ""
    MyArry1(1) = "واحد"
    MyArry1(2) = "إثنان"
    MyArry1(3) = "ثلاثة"
    MyArry1(4) = "أربعة"
    MyArry1(5) = "خمسة"
    MyArry1(6) = "ستة"
    MyArry1(7) = "سبعة"
    MyArry1(8) = "ثمانية"
    MyArry1(9) = "تسعة"

    MyArry2(0) = ""
    MyArry2(1) = " عشر"
    MyArry2(2) = "عشرون"
    MyArry2(3) = "ثلاثون"
    MyArry2(4) = "أربعون"
    MyArry2(5) = "خمسون"
    MyArry2(6) = "ستون"
    MyArry2(7) = "سبعون"
    MyArry2(8) = "ثمانون"
    MyArry2(9) = "تسعون"

    MyArry3(0) = ""
    MyArry3(1) = "مئة"
    MyArry3(2) = "مئتان"
    MyArry3(3) = "ثلاثمائة"
    MyArry3(4) = "اربعمائة"
    MyArry3(5) = "خمسمائة"
    MyArry3(6) = "ستمائة"
    MyArry3(7) = "سبعمائة"
    MyArry3(8) = "تمانمائة"
    MyArry3(9) = "تسعمائة"
    '======================
    If Dec3Digit Then
        GetNo = Format(TheNo, "000000000000.000")
    Else
        GetNo = Format(TheNo, "000000000000.00")
    End If
    '======================
    Dim i As Integer
    For i = 0 To 14 Step 3

        If i < 12 Then
            MyNo = Mid$(GetNo, i + 1, 3)
        Else
            If Dec3Digit Then
                MyNo = Mid$(GetNo, i + 2, 3)
            Else
                MyNo = "0" + Mid$(GetNo, i + 2, 3)
            End If
        End If

        If (Mid$(MyNo, 1, 3)) > 0 Then

            RdNo = Mid$(MyNo, 1, 1)
            My100 = MyArry3(RdNo)
            RdNo = Mid$(MyNo, 3, 1)
            My1 = MyArry1(RdNo)
            RdNo = Mid$(MyNo, 2, 1)
            My10 = MyArry2(RdNo)

            If Mid$(MyNo, 2, 2) = 11 Then My11 = "أحد عشر"
            If Mid$(MyNo, 2, 2) = 12 Then My12 = "أثنا عشر"
            If Mid$(MyNo, 2, 2) = 10 Then My10 = "عشرة"

            If ((Mid$(MyNo, 1, 1)) > 0) And ((Mid$(MyNo, 2, 2)) > 0) Then My100 = My100 + MyAnd
            If ((Mid$(MyNo, 3, 1)) > 0) And ((Mid$(MyNo, 2, 1)) > 1) Then My1 = My1 + MyAnd

            GetTxt = My100 + My1 + My10

            If ((Mid$(MyNo, 3, 1)) = 1) And ((Mid$(MyNo, 2, 1)) = 1) Then
                GetTxt = My100 + My11
                If ((Mid$(MyNo, 1, 1)) = 0) Then GetTxt = My11
            End If

            If ((Mid$(MyNo, 3, 1)) = 2) And ((Mid$(MyNo, 2, 1)) = 1) Then
                GetTxt = My100 + My12
                If ((Mid$(MyNo, 1, 1)) = 0) Then GetTxt = My12
            End If

            If (i = 0) And (GetTxt <> "") Then
                If ((Mid$(MyNo, 1, 3)) > 10) Then
                    Mybillion = GetTxt + " مليون"
                Else
                    Mybillion = GetTxt + " مليون"
                    If ((Mid$(MyNo, 1, 3)) = 2) Then Mybillion = " مليون"
                    If ((Mid$(MyNo, 1, 3)) = 2) Then Mybillion = " ملايين"
                End If
            End If

            If (i = 3) And (GetTxt <> "") Then

                If ((Mid$(MyNo, 1, 3)) > 10) Then
                    MyMillion = GetTxt + " مليون"
                Else
                    MyMillion = GetTxt + " ملايين"
                    If ((Mid$(MyNo, 1, 3)) = 1) Then MyMillion = " مليون"
                    If ((Mid$(MyNo, 1, 3)) = 2) Then MyMillion = " ملايين"
                End If
            End If

            If (i = 6) And (GetTxt <> "") Then
                If ((Mid$(MyNo, 1, 3)) > 10) Then
                    MyThou = GetTxt + " ألف"
                Else
                    MyThou = GetTxt + " آلاف"
                    If ((Mid$(MyNo, 3, 1)) = 1) Then MyThou = " ألف"
                    If ((Mid$(MyNo, 3, 1)) = 2) Then MyThou = " آلاف"
                End If
            End If

            If (i = 9) And (GetTxt <> "") Then MyHun = GetTxt
            If (i = 12) And (GetTxt <> "") Then MyFraction = GetTxt
        End If
    Next

    If (Mybillion <> "") Then
        If (MyMillion <> "") Or (MyThou <> "") Or (MyHun <> "") Then Mybillion = Mybillion + MyAnd
    End If

    If (MyMillion <> "") Then
        If (MyThou <> "") Or (MyHun <> "") Then MyMillion = MyMillion + MyAnd
    End If

    If (MyThou <> "") Then
        If (MyHun <> "") Then MyThou = MyThou + MyAnd
    End If

    If MyFraction <> "" Then
        If (Mybillion <> "") Or (MyMillion <> "") Or (MyThou <> "") Or (MyHun <> "") Then
            NoToTxt = ReMark + Mybillion + MyMillion + MyThou + MyHun + " " + MyCur + MyAnd + MyFraction + " " + MySubCur
        Else
            NoToTxt = ReMark + MyFraction + " " + MySubCur
        End If
    Else
        NoToTxt = ReMark + Mybillion + MyMillion + MyThou + MyHun + " " + MyCur
    End If

End Function

.....
الرد }}}}
#3
السلام عليكم

لم تنجح معي ممكن مثال اخي ..بارك الله فيك
Heartاحبكم في اللهHeart
http://www.vb4arb.com/vb4arb2.gif
الرد }}}}
تم الشكر بواسطة:
#4
(10-06-14, 01:20 AM)princeofislam كتب : السلام عليكم

لم تنجح معي ممكن مثال اخي ..بارك الله فيك

السلام عليكم

البرنامج رائع ويعمل ما هو مطلوب وارفق مثال على ذلك

يعطيكم العافية


الملفات المرفقة
.rar   تفقيط الارقام.rar (الحجم : 2.45 ك ب / التحميلات : 296)
(( يَا أَيَّتُهَا النَّفْسُ الْمُطْمَئِنَّةُ ارْجِعِي إِلَى رَبِّكِ رَاضِيَةً مَرْضِيَّةً فَادْخُلِي فِي عِبَادِي وَادْخُلِي جَنَّتِي ))

الرد }}}}
تم الشكر بواسطة: princeofislam , prj
#5
بارك الله بك يا اخي ابو الليث انا اسف ما كنت اون لاين كنت مريضا ..

الله يسعدك و ريح بالك اخي ..اللهم امين واحلى منتدى في العالم
Heartاحبكم في اللهHeart
http://www.vb4arb.com/vb4arb2.gif
الرد }}}}
تم الشكر بواسطة: prj
#6
بارك الله فيك يا أخي وجعلة فى ميزان حسناتك
الرد }}}}
تم الشكر بواسطة:
#7
لدي برنامج تفقيط وهو على نظام القروش ( كسر العشر الثنائي ) لكن اريده على نظام كسر العشر الثلاثي

ارجوا المساعده

(07-06-14, 08:21 PM)princeofislam كتب : السلام عليكم ورحمة الله و بركاتة

احتاح لبرنامج التفقيط و طباعة الشيكات بالعملة الاردنية ان امكن ..وجزاكم الله خيرا يا ربي
الرد }}}}
تم الشكر بواسطة:
#8
السلام عليكم

اخي الكريم انظر الى المثال الموجود في هذا الموضوع انه تفقط لثلاث منازل عشرية
او ارفق المثال الموجود لديك لكي يتم التعديل عليه

حياك الله
الرد }}}}
تم الشكر بواسطة:


المواضيع المحتمل أن تكون متشابهة .
الموضوع : الكاتب الردود : المشاهدات : آخر رد
  [مشروع] برنامج تكاليف البناء sulimanalahdl 4 62 13-11-17, 12:22 AM
آخر رد: Amir_alzubidy
  [مشروع] برنامج مدرسة تحفيظ القرآن sulimanalahdl 3 54 13-11-17, 12:20 AM
آخر رد: Amir_alzubidy
  [مشروع] برنامج الصندوق التطوعي لكفالة الأيتام sulimanalahdl 6 49 12-11-17, 02:44 PM
آخر رد: sulimanalahdl
  مثال أو برنامج للتعامل مع الماسح الضوئي أو السكانر بإستخدام مكتبة WIA الرائعه Ahmed_Mansoor 14 253 01-11-17, 08:13 AM
آخر رد: Ahmed_Mansoor
  برنامج مبيعات خاص Ahmed_Mansoor 27 3,835 30-10-17, 03:01 PM
آخر رد: bridgesky
  برنامج الفاتورة: لأرشفة الفواتير و عمل جرد دائم للمواد. Mohamad Anan 6 230 14-10-17, 11:13 PM
آخر رد: Mohamad Anan
Wink [vb6.0] مشروع برنامج لمتابعة الجوازات ورخص العمل thecareep 4 669 14-10-17, 04:59 AM
آخر رد: thecareep
Wink [vb6.0] مشروع برنامج لمتابعة السيارات thecareep 9 1,003 14-10-17, 04:58 AM
آخر رد: thecareep
  [VB.NET] برنامج سوبر ماركيت كامل و متطور ومفتوح المصدر اي مع الكود البرمجي فقط ب 14 دولار البر amer1990 1 118 26-09-17, 02:32 AM
آخر رد: wale90
  [vb6.0] برنامج جدول الحصص الاسبوعي ابن دوعن 3 674 26-08-17, 11:53 AM
آخر رد: Amir_alzubidy

التنقل السريع :


يقوم بقرائة الموضوع: بالاضافة الى ( 1 ) ضيف كريم