تقييم الموضوع :
  • 0 أصوات - بمعدل 0
  • 1
  • 2
  • 3
  • 4
  • 5
دالة تفقيط المبلغ الى حروف
#1
كود :
Option Strict Off
Option Explicit Off
Imports Microsoft.Win32
Imports Microsoft.VisualBasic
Module Module_Tafkeet

   Public Function HAZEM(ByVal HAZEM1 As Object, ByVal HAZEM2 As String) As String
       On Error Resume Next
       Dim VPS As Decimal = 0
       Dim V As Decimal = 0
       Dim WORDINTEGER As String = ""
       Dim LE As String = ""
       Dim P As String = ""
       Dim PS As String = ""
       HAZEM = ""
       Dim POUNDS As String = ""
       Dim WORDPS As String = ""
       Dim DOLLAR As String = ""
       Dim SENT As String = ""
       Dim SENTS As String = ""
       Dim TON As String = ""
       Dim KG As String = ""
       Dim KGS As String = ""
       Select Case HAZEM2
           Case "KSA"
               LE = " دينار "
               P = " فلس "
               PS = " فلس "
               POUNDS = " دينار "
               V = Int(Math.Abs(HAZEM1))
               VPS = Val(Right(Format(HAZEM1, "000000000000.000"), 3))
               WORDINTEGER = AmountWord(V)
               WORDPS = AmountWord(VPS)
               If WORDINTEGER <> "" And (VPS <= 2) Then HAZEM = WORDINTEGER & LE & " و " & WORDPS & P & "فقط لاغير "
               If WORDINTEGER <> "" And (VPS >= 3 And VPS <= 9) Then HAZEM = WORDINTEGER & LE & " و " & WORDPS & PS & "فقط لاغير "
               If WORDINTEGER <> "" And (VPS > 9) Then HAZEM = WORDINTEGER & LE & " و " & WORDPS & P & "فقط لاغير "
               If WORDINTEGER = "" And (VPS <= 2) Then HAZEM = WORDPS & P & "فقط لاغير "
               If WORDINTEGER = "" And (VPS >= 3 And VPS <= 9) Then HAZEM = WORDPS & PS & "فقط لاغير "
               If WORDINTEGER = "" And VPS > 9 Then HAZEM = WORDPS & P & "فقط لاغير "
               If WORDINTEGER = "" And VPS = 0 Then HAZEM = ""
               If WORDINTEGER <> "" And VPS = 0 Then HAZEM = WORDINTEGER & LE & "فقط لاغير "

       End Select
   End Function
   Private Function AmountWord(ByVal AMOUNT As Decimal) As String
       On Error Resume Next
       Dim n As Decimal = 0
       Dim C1 As Decimal = 0
       Dim C2 As Decimal = 0
       Dim C3 As Decimal = 0
       Dim C4 As Decimal = 0
       Dim C5 As Decimal = 0
       Dim C6 As Decimal = 0
       Dim S1 As String = ""
       Dim S2 As String = ""
       Dim S3 As String = ""
       Dim S4 As String = ""
       Dim S5 As String = ""
       Dim S6 As String = ""
       Dim C As String = ""
       n = Int(AMOUNT)
       C = Format(n, "000000000000")
       C1 = Val(Mid(C, 12, 1))
       Select Case C1
           Case Is = 1 : S1 = "واحد"
           Case Is = 2 : S1 = "اثنان"
           Case Is = 3 : S1 = "ثلاثة"
           Case Is = 4 : S1 = "اربعة"
           Case Is = 5 : S1 = "خمسة"
           Case Is = 6 : S1 = "ستة"
           Case Is = 7 : S1 = "سبعة"
           Case Is = 8 : S1 = "ثمانية"
           Case Is = 9 : S1 = "تسعة"
       End Select

       C2 = Val(Mid(C, 11, 1))
       Select Case C2
           Case Is = 1 : S2 = "عشر"
           Case Is = 2 : S2 = "عشرون"
           Case Is = 3 : S2 = "ثلاثون"
           Case Is = 4 : S2 = "اربعون"
           Case Is = 5 : S2 = "خمسون"
           Case Is = 6 : S2 = "ستون"
           Case Is = 7 : S2 = "سبعون"
           Case Is = 8 : S2 = "ثمانون"
           Case Is = 9 : S2 = "تسعون"
       End Select

       If S1 <> "" And C2 > 1 Then S2 = S1 + " و" + S2
       If S2 = "" Then S2 = S1
       If C1 = 0 And C2 = 1 Then S2 = S2 + "ة"
       If C1 = 1 And C2 = 1 Then S2 = "احدى عشر"
       If C1 = 2 And C2 = 1 Then S2 = "اثنى عشر"
       If C1 > 2 And C2 = 1 Then S2 = S1 + " " + S2
       C3 = Val(Mid(C, 10, 1))
       Select Case C3
           Case Is = 1 : S3 = "مائة"
           Case Is = 2 : S3 = "مئتان"
           Case Is > 2 : S3 = Left(AmountWord(C3), Len(AmountWord(C3)) - 1) + "مائة"
       End Select
       If S3 <> "" And S2 <> "" Then S3 = S3 + " و" + S2
       If S3 = "" Then S3 = S2

       C4 = Val(Mid(C, 7, 3))
       Select Case C4
           Case Is = 1 : S4 = "الف"
           Case Is = 2 : S4 = "الفان"
           Case 3 To 10 : S4 = AmountWord(C4) + " آلاف"
           Case Is > 10 : S4 = AmountWord(C4) + " الف"
       End Select
       If S4 <> "" And S3 <> "" Then S4 = S4 + " و" + S3
       If S4 = "" Then S4 = S3
       C5 = Val(Mid(C, 4, 3))
       Select Case C5
           Case Is = 1 : S5 = "مليون"
           Case Is = 2 : S5 = "مليونان"
           Case 3 To 10 : S5 = AmountWord(C5) + " ملايين"
           Case Is > 10 : S5 = AmountWord(C5) + " مليون"
       End Select
       If S5 <> "" And S4 <> "" Then S5 = S5 + " و" + S4
       If S5 = "" Then S5 = S4

       C6 = Val(Mid(C, 1, 3))

       Select Case C6
           Case Is = 1 : S6 = "مليار"
           Case Is = 2 : S6 = "ملياران"
           Case Is > 2 : S6 = AmountWord(C6) + " مليار"
       End Select
       If S6 <> "" And S5 <> "" Then S6 = S6 + " و" + S5
       If S6 = "" Then S6 = S5
       AmountWord = S6
   End Function

End Module
هذة الدالة تقوم بالتفقيط كالتالي
علي سيبل المثال    1500.750   دينار كويتى

 الف وخمسمائة دينار  وسبعمائة خمسون فلس فقط لاغير

ما اريدة

الف وخمسمائة دينار و 750 فلس فقط لاغير

وجزاكم الله خير الجزاء
الرد
تم الشكر بواسطة:
#2
قم بالبحث فى الكود على السطر التالى
كود :
WORDPS = AmountWord(VPS)

واستبدله بالسطر التالى
كود :
WORDPS = VPS 'AmountWord(VPS)

جرب وابشر بما تم معك

تحياتى لك
وتمنياتى لك التوفيق
{ وَقُل رَّبِّ زِدْنِي عِلْمًا }
[ كن على يقين من اعمالنا نخطئ ومن اخطائنا نتعلم ولذلك لا شي مستحيل ]

ساهم دائماً فى    لكل من يقوم بالمساهمة
فى حل المشكلة او الاستفسار لديك فالجميع هنا يعمل 
على مساعدة الاخرين لوجه الله وان تحتسب له اجر عند الله


 شرح كيفية عمل قاعدة بيانات تعمل على اكثر من جهاز على الشبكة الداخلية
الرد
تم الشكر بواسطة:
#3
تسلم
جزاك الله كل خير اخى الفاضل
الرد
تم الشكر بواسطة:
#4
(09-08-18, 12:21 AM)السيد الجوهري كتب : تسلم
جزاك الله كل خير اخى الفاضل


بالتوفيق اخى السيد


تحياتى لك
{ وَقُل رَّبِّ زِدْنِي عِلْمًا }
[ كن على يقين من اعمالنا نخطئ ومن اخطائنا نتعلم ولذلك لا شي مستحيل ]

ساهم دائماً فى    لكل من يقوم بالمساهمة
فى حل المشكلة او الاستفسار لديك فالجميع هنا يعمل 
على مساعدة الاخرين لوجه الله وان تحتسب له اجر عند الله


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


المواضيع المحتمل أن تكون متشابهة .
الموضوع : الكاتب الردود : المشاهدات : آخر رد
  [سؤال] كتابة دالة Simo1991 4 101 30-10-18, 09:05 PM
آخر رد: elgokr
  [VB.NET] دالة أقوى من SendKeys لمحاكاة الكيبورد sniperjawadino 2 147 23-10-18, 06:22 PM
آخر رد: sniperjawadino
  [VB.NET] استفسار :- Speech To Text تحويل الصوت الى حروف dubai.eig 1 182 05-10-18, 07:08 PM
آخر رد: alsouf
  دالة الجمع في كريستل ريبورت makky 7 259 30-08-18, 07:01 PM
آخر رد: elgokr
  دالة الوقت now alfauori 4 244 16-07-18, 12:07 AM
آخر رد: elgokr
Lightbulb [سؤال] اريد مشروع تحويل الارقام الى حروف فرنسية بالفجوال بيسك نت tichouckt 3 388 19-03-18, 02:28 AM
آخر رد: عبد العزيز البسكري
  عملة دالة لاستخراج اسم المحافظة atefkhalf2004 19 540 24-02-18, 11:13 PM
آخر رد: atefkhalf2004
  نرجع مرة ثانية , الاداة datagrideview ممنوع تكتب حروف بس في مشكلة nooralcown 2 180 05-02-18, 02:29 PM
آخر رد: nooralcown
  كيف يتم اظهار كلمة مدين اذاكان المبلغ موجب ودائن اذا كان المبلغ سالب بجوار Textbox السيد الجوهري 1 288 08-01-18, 02:06 PM
آخر رد: nooralcown
  [سؤال] رغم استخدام دالة المعالج الخلفي إلا أنه ما زال يوجد تهنيج عند تنفيذ الكود السندبااد 6 521 25-10-17, 05:29 PM
آخر رد: السندبااد

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


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