تقييم الموضوع :
  • 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 ك ب / التحميلات : 469)
(( يَا أَيَّتُهَا النَّفْسُ الْمُطْمَئِنَّةُ ارْجِعِي إِلَى رَبِّكِ رَاضِيَةً مَرْضِيَّةً فَادْخُلِي فِي عِبَادِي وَادْخُلِي جَنَّتِي ))

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

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

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

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

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

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

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



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


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