[السيد الجوهري]

(09-03-18, 01:30 PM)Abdulhakeem Swisi كتب : السلام عليكم ورحمة الله وبركاته
قمت قبل فترة قصيرة بتطوير دالة تفقيط تكون مرنة ودقيقة في ضبط المسافة بين الكلمات
وهي تعتمد على مبدأ باقي القسمة mod وفكرتها بسيطة جدا.
أولا قم بانشاء module وضع فيه هذا الكود:

كود :

'# Created By Abdulhakeem Swissi, Libya, 01/02/2018.#
'www.abdulhakeemswissi@gmail.com

Module ConvertNumbersToWords_Module

   Dim and_Str As String = " و "

   Public Function ConvertNumbersToWords(ByVal Number As Decimal, ByVal NameOfUnitBeforeDecimal As String, ByVal NameOfUnitAfterDecimal As String, Optional ByVal CustomTextBeforeWordsOfDigits As String = "", Optional ByVal CustomTextAfterWordsOfDigits As String = "") As String
       ConvertNumbersToWords = String.Empty
       Dim numbersArray_Str(2) As String
       numbersArray_Str = Split(CStr(Number), ".")
       Dim numberBeforePoint_Lng, numberAfterPoint_Lng As Long
       If numbersArray_Str(0).Length <= 15 Then
           If numbersArray_Str(0) <> String.Empty Then
               numberBeforePoint_Lng = CLng(numbersArray_Str(0))
           End If
       Else
           Return String.Empty
           Exit Function
       End If
       If numbersArray_Str.Length > 1 Then
           If numbersArray_Str(1).Length <= 15 Then
               If numbersArray_Str(1) <> String.Empty Then
                   numberAfterPoint_Lng = CLng(numbersArray_Str(1))
               End If
           Else
               Return String.Empty
               Exit Function
           End If
       End If
       If numberAfterPoint_Lng <> 0 Then
           If numberBeforePoint_Lng > 0 Then
               Return (CustomTextBeforeWordsOfDigits & " " & wordsOfDigits(numberBeforePoint_Lng) & " " & NameOfUnitBeforeDecimal & and_Str & wordsOfDigits(numberAfterPoint_Lng) & " " & NameOfUnitAfterDecimal & " " & CustomTextAfterWordsOfDigits).Trim
           Else
               Return (CustomTextBeforeWordsOfDigits & " " & wordsOfDigits(numberAfterPoint_Lng) & " " & NameOfUnitAfterDecimal & " " & CustomTextAfterWordsOfDigits).Trim
           End If
       Else
           If numberBeforePoint_Lng > 0 Then
               Return (CustomTextBeforeWordsOfDigits & " " & wordsOfDigits(numberBeforePoint_Lng) & " " & NameOfUnitBeforeDecimal & " " & CustomTextAfterWordsOfDigits).Trim
           End If
       End If
   End Function

   Private Function wordsOfDigits(ByVal number As Long) As String
       wordsOfDigits = String.Empty
       If number <= 10 Then
           Select Case number
               Case Is = 1 : Return "واحد"
               Case Is = 2 : Return "اثنان"
               Case Is = 3 : Return "ثلاثة"
               Case Is = 4 : Return "أربعة"
               Case Is = 5 : Return "خمسة"
               Case Is = 6 : Return "ستة"
               Case Is = 7 : Return "سبعة"
               Case Is = 8 : Return "ثمانية"
               Case Is = 9 : Return "تسعة"
               Case Is = 10 : Return "عشرة"
           End Select
       End If
       If number >= 11 And number <= 19 Then
           Select Case number
               Case Is = 11 : Return "أحد عشر"
               Case Is = 12 : Return "اثنا عشر"
               Case Is = 13 : Return "ثلاثة عشر"
               Case Is = 14 : Return "أربعة عشر"
               Case Is = 15 : Return "خمسة عشر"
               Case Is = 16 : Return "ستة عشر"
               Case Is = 17 : Return "سبعة عشر"
               Case Is = 18 : Return "ثمانية عشر"
               Case Is = 19 : Return "تسعة عشر"
           End Select
       End If
       If number >= 20 And number <= 99 Then
           Dim firstDigit_Lng As Long = number Mod 10
           Dim secondDigit_Lng As Long = number \ 10
           Dim wordOfDigit_Str As String = String.Empty
           Select Case secondDigit_Lng
               Case Is = 2 : wordOfDigit_Str = "عشرون"
               Case Is = 3 : wordOfDigit_Str = "ثلاثون"
               Case Is = 4 : wordOfDigit_Str = "أربعون"
               Case Is = 5 : wordOfDigit_Str = "خمسون"
               Case Is = 6 : wordOfDigit_Str = "ستون"
               Case Is = 7 : wordOfDigit_Str = "سبعون"
               Case Is = 8 : wordOfDigit_Str = "ثمانون"
               Case Is = 9 : wordOfDigit_Str = "تسعون"
           End Select
           If firstDigit_Lng <> 0 Then
               wordOfDigit_Str = wordsOfDigits(firstDigit_Lng) & and_Str & wordOfDigit_Str
           End If
           Return wordOfDigit_Str
       End If
       If number >= 100 And number <= 999 Then
           Dim firstDigit_Lng As Long = number Mod 100
           Dim secondDigit_Lng As Long = number \ 100
           Dim wordOfDigit_Str As String = String.Empty
           Select Case secondDigit_Lng
               Case Is = 1 : wordOfDigit_Str = "مائة"
               Case Is = 2 : wordOfDigit_Str = "مائتان"
               Case Is = 3 : wordOfDigit_Str = "ثلاثمائة"
               Case Is = 4 : wordOfDigit_Str = "أربعمائة"
               Case Is = 5 : wordOfDigit_Str = "خمسمائة"
               Case Is = 6 : wordOfDigit_Str = "ستمائة"
               Case Is = 7 : wordOfDigit_Str = "سبعمائة"
               Case Is = 8 : wordOfDigit_Str = "ثمانمائة"
               Case Is = 9 : wordOfDigit_Str = "تسعمائة"
           End Select
           If firstDigit_Lng <> 0 Then
               wordOfDigit_Str = wordOfDigit_Str & and_Str & wordsOfDigits(firstDigit_Lng)
           End If
           Return wordOfDigit_Str
       End If
       If number >= 1000 And number <= 999999 Then
           Dim firstDigit_Lng As Long = number Mod 1000
           Dim secondDigit_Lng As Long = number \ 1000
           Dim wordOfDigit_Str As String = String.Empty
           Select Case secondDigit_Lng
               Case Is = 1 : wordOfDigit_Str = "ألف"
               Case Is = 2 : wordOfDigit_Str = "ألفان"
               Case Is <= 10
                   wordOfDigit_Str = " آلاف"
                   wordOfDigit_Str = wordsOfDigits(secondDigit_Lng) & wordOfDigit_Str
               Case Else
                   wordOfDigit_Str = " ألف"
                   wordOfDigit_Str = wordsOfDigits(secondDigit_Lng) & wordOfDigit_Str
           End Select
           If firstDigit_Lng <> 0 Then
               wordOfDigit_Str = wordOfDigit_Str & and_Str & wordsOfDigits(firstDigit_Lng)
           End If
           Return wordOfDigit_Str
       End If
       If number >= 1000000 And number <= 999999999 Then
           Dim firstDigit_Lng As Long = number Mod 1000000
           Dim secondDigit_Lng As Long = number \ 1000000
           Dim wordOfDigit_Str As String = String.Empty
           Select Case secondDigit_Lng
               Case Is = 1 : wordOfDigit_Str = "مليون"
               Case Is = 2 : wordOfDigit_Str = "مليونان"
               Case Is <= 10
                   wordOfDigit_Str = " ملايين"
                   wordOfDigit_Str = wordsOfDigits(secondDigit_Lng) & wordOfDigit_Str
               Case Else
                   wordOfDigit_Str = " مليون"
                   wordOfDigit_Str = wordsOfDigits(secondDigit_Lng) & wordOfDigit_Str
           End Select
           If firstDigit_Lng <> 0 Then
               wordOfDigit_Str = wordOfDigit_Str & and_Str & wordsOfDigits(firstDigit_Lng)
           End If
           Return wordOfDigit_Str
       End If
       If number >= 1000000000 And number <= 999999999999 Then
           Dim firstDigit_Lng As Long = number Mod 1000000000
           Dim secondDigit_Lng As Long = number \ 1000000000
           Dim wordOfDigit_Str As String = String.Empty
           Select Case secondDigit_Lng
               Case Is = 1 : wordOfDigit_Str = "مليار"
               Case Is = 2 : wordOfDigit_Str = "ملياران"
               Case Else
                   wordOfDigit_Str = " مليار"
                   wordOfDigit_Str = wordsOfDigits(secondDigit_Lng) & wordOfDigit_Str
           End Select
           If firstDigit_Lng <> 0 Then
               wordOfDigit_Str = wordOfDigit_Str & and_Str & wordsOfDigits(firstDigit_Lng)
           End If
           Return wordOfDigit_Str
       End If
       If number >= 1000000000000 And number <= 999999999999999 Then
           Dim firstDigit_Lng As Long = number Mod 1000000000000
           Dim secondDigit_Lng As Long = number \ 1000000000000
           Dim wordOfDigit_Str As String = String.Empty
           Select Case secondDigit_Lng
               Case Is = 1 : wordOfDigit_Str = "تريليون"
               Case Else
                   wordOfDigit_Str = " تريليون"
                   wordOfDigit_Str = wordsOfDigits(secondDigit_Lng) & wordOfDigit_Str
           End Select
           If firstDigit_Lng <> 0 Then
               wordOfDigit_Str = wordOfDigit_Str & and_Str & wordsOfDigits(firstDigit_Lng)
           End If
           Return wordOfDigit_Str
       End If
   End Function

End Module

ثم يمكن ارسالة بارميترات للدالة كالتالي:

كود :

ConvertNumbersToWords(123.123D, "دينار", "درهم", "فقط (", ") لاغير .")

أو :

كود :

ConvertNumbersToWords(123.123D, "دينار", "درهم")

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

ولتوضيح أي جزء من الكود أو أي تعديل أنا حاضر

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

ليكون  مائة دينار و 750 فلس 

وشكرا جزيلا