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

حيث إني أفتقد القراءة في الفاصلة العشرية الثالثة

وإذا ممكن وجود كلمة And من بعد الدينار

أو أي تفقيط بالدينار والفلس باللغة الإنجليزية
ولكم مني الشكر والتقدير

Option Compare Database



Option Explicit



Function ConvertCurrencyToEnglish(ByVal MyNumber)



  Dim Temp



         Dim Dinars, Fils



         Dim DecimalPlace, Count



         ReDim Place(9) As String



         Place(2) = " Thousand "



         Place(3) = " Million "



         Place(4) = " Billion "



         Place(5) = " Trillion "



         MyNumber = Trim(Str(MyNumber))



         DecimalPlace = InStr(MyNumber, ".")



        If DecimalPlace > 0 Then



         Temp = Left(Mid(MyNumber, DecimalPlace + 1) & "00", 2)



            Fils = ConvertTens(Temp)



            MyNumber = Trim(Left(MyNumber, DecimalPlace - 1))



         End If



         Count = 1



         Do While MyNumber <> ""



            Temp = ConvertHundreds(Right(MyNumber, 3))



            If Temp <> "" Then Dinars = Temp & Place(Count) & Dinars



            If Len(MyNumber) > 3 Then



               MyNumber = Left(MyNumber, Len(MyNumber) - 3)



            Else



               MyNumber = ""



            End If



            Count = Count + 1



         Loop



         Select Case Dinars



            Case ""



               Dinars = "Zero Dinar"



            Case "One"



               Dinars = "One Dinar"



            Case Else



               Dinars = Dinars & " Dinars"



         End Select



         Select Case Fils



            Case ""



               Fils = " Zero Fils Only"



            Case "One"



               Fils = " And One Fils Only"



            Case Else



               Fils = " And " & Fils & " Fils Only"



         End Select



         ConvertCurrencyToEnglish = Dinars & Fils



End Function



Private Function ConvertDigit(ByVal MyDigit)



        Select Case Val(MyDigit)



            Case 1: ConvertDigit = "One"



            Case 2: ConvertDigit = "Two"



            Case 3: ConvertDigit = "Three"



            Case 4: ConvertDigit = "Four"



            Case 5: ConvertDigit = "Five"



            Case 6: ConvertDigit = "Six"



            Case 7: ConvertDigit = "Seven"



            Case 8: ConvertDigit = "Eight"



            Case 9: ConvertDigit = "Nine"



            Case Else: ConvertDigit = ""



         End Select



End Function



Private Function ConvertHundreds(ByVal MyNumber)



    Dim Result As String



         If Val(MyNumber) = 0 Then Exit Function



         MyNumber = Right("000" & MyNumber, 3)



         If Left(MyNumber, 1) <> "0" Then



            Result = ConvertDigit(Left(MyNumber, 1)) & " Hundred "



         End If



         If Mid(MyNumber, 2, 1) <> "0" Then



            Result = Result & ConvertTens(Mid(MyNumber, 2))



         Else



            Result = Result & ConvertDigit(Mid(MyNumber, 3))



         End If



         ConvertHundreds = Trim(Result)



End Function



Private Function ConvertTens(ByVal MyTens)



          Dim Result As String



         If Val(Left(MyTens, 1)) = 1 Then



            Select Case Val(MyTens)



               Case 10: Result = "Ten"



               Case 11: Result = "Eleven"



               Case 12: Result = "Twelve"



               Case 13: Result = "Thirteen"



               Case 14: Result = "Fourteen"



               Case 15: Result = "Fifteen"



               Case 16: Result = "Sixteen"



               Case 17: Result = "Seventeen"



               Case 18: Result = "Eighteen"



               Case 19: Result = "Nineteen"



               Case Else



            End Select



         Else



         



            Select Case Val(Left(MyTens, 1))



               Case 2: Result = "Twenty "



               Case 3: Result = "Thirty "



               Case 4: Result = "Forty "



               Case 5: Result = "Fifty "



               Case 6: Result = "Sixty "



               Case 7: Result = "Seventy "



               Case 8: Result = "Eighty "



               Case 9: Result = "Ninety "



               Case Else



            End Select



            Result = Result & ConvertDigit(Right(MyTens, 1))



         End If



         ConvertTens = Result



End Function
الرد }}}
تم الشكر بواسطة:
#2
السلام عليكم و رحمة الله و بركاته 
هذا مثال للتفقيط باللغة الانجليزية 

.rar   eng-tafkeet.rar (الحجم : 19.48 ك ب / التحميلات : 43)
 المرجع
الرد }}}
تم الشكر بواسطة: عبد العزيز البسكري
#3
السلام عليكم و رحمة الله و بركاته
أخي إنها نفس التفقيط الذي أستعمله
مشكلته إنه يقرأ لرقمين بعد الفاصلة العشرية
هل هناك حل لقراءة ثلاثة أرقام بعد الفاصلة العشرية
الرد }}}
تم الشكر بواسطة:
#4
السلام عليكم و رحمة الله 
هذا مثال للاخ الاستاذ abbashmd  ابو هادي قمت بالتعديل عليه 


ليتوافق مع المطلوب 
المرجع

كما اتمنى مراجعة التغيرات التي تمت بين المرفقين حتى تعم الفائدة

   
   

المثال :

.rar   Num2Text.rar (الحجم : 58.79 ك ب / التحميلات : 74)
الرد }}}
#5
أخي لم أستطع إستدعاء الدالة .. لا تظهر لدي
سأحاول فإن لم أستطع سأرفق الملف
ولكم كل الشكر والتقدير
قضى الله حوائجكم بالدنيا والآخرة
الرد }}}
تم الشكر بواسطة:
#6
إخواني الملف مرفق
إسم النموذج new invoice
برجائي التعديل عليه باللغة الإنجليزية بقراءة 3 فواصل عشرية للدينار والفلس
مع شكري وإمتناني للجميع



الملف:

https://www.dropbox.com/s/57ryip591epp3x4/12.accdb?dl=0
الرد }}}
تم الشكر بواسطة:
#7
هل من معين
الرد }}}
تم الشكر بواسطة:


المواضيع المحتمل أن تكون متشابهة .
الموضوع : الكاتب الردود : المشاهدات : آخر رد
  تعديل على كود او اضافة sm44ms 4 154 24-02-24, 01:27 AM
آخر رد: Ezril5
  لمن لهم خبرة فى التعامل مع الباركود رجاء المساعدة ابو طارق 0 341 14-03-23, 09:52 AM
آخر رد: ابو طارق
  [Acces2010] طلب المساعدة في عمل برنامج ارشفة مستندات الموظفين belal musallam 0 743 07-12-22, 04:21 PM
آخر رد: belal musallam
  [VB.NET] طلب المساعدة في عمل برنامج ارشفة مستندات الموظفين belal musallam 0 496 07-12-22, 04:20 PM
آخر رد: belal musallam
  [سؤال] محتاج شرح بسيط ارجوا المساعدة معاذ السامرائي 0 634 06-07-22, 12:58 PM
آخر رد: معاذ السامرائي
  [مشروع] تعديل الفرم Ahmedalkarimi 0 682 17-06-22, 06:23 PM
آخر رد: Ahmedalkarimi
  المساعدة فى اتمام القاعدة المرفقة ابن فلسطين 0 659 04-02-22, 05:43 PM
آخر رد: ابن فلسطين
  [كود] اطلب المساعدة tounsi hafedh 0 636 18-01-22, 09:43 PM
آخر رد: tounsi hafedh
  [Acces2003] لا تظهر خيارات لإظهار فواصل الأرقام ESAMHGR 0 751 28-12-21, 11:13 AM
آخر رد: ESAMHGR
  عمل تعديل علي ملف اكسل مجدي عليان 0 837 10-02-21, 01:04 AM
آخر رد: مجدي عليان

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


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