تقييم الموضوع :
  • 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)السيد الجوهري كتب : تسلم
جزاك الله كل خير اخى الفاضل


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


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

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


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



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


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