التفقيط باستخدام اكسل - تحويل الأرقام إلى حروف مكتوبة

الكود المرفق يقوم بتحويل أي رقم إلى حروف (التفقيط) باللغة العربية بالجنيه المصري.

قم بنسخ الكود المرفق و إضافته في Excel VB و ستعمل الوظيفة Monitize كأحد الوظائف الموجودة بإكسل و تساعدك على تحويل أي رقم إلى مبلغ مالي بالحروف بالجنيه المصري. الفيديو التالي يوضح كيفية استخدام الوظيفة الجديدة:

يمكنك نسخ الكود التالي بالكامل و إضافته في إكسل لاستخدامه بعد ذلك. ملحوظة: تم عمل هذا الكود لإجراء وظيفة محددة و يجب اختباره جيدا قبل استخدامه بشكل احترافي.

Public Function Monitize(num_entry)
Dim LE
Dim PT
Dim iVal
Dim fFrac
Dim cDigit
Dim cFrac
Dim result

      LE = " جنيه "
      PT = " قرش "
      iVal = Int(num_entry)
      cDigit = Digit_Translator(iVal)
      fFrac = Val(Right(Format(num_entry, "000000000000.00"), 2))
      cFrac = Digit_Translator(fFrac)
      If cDigit <> "" And fFrac > 0 Then result = cDigit & LE & " و " & cFrac & PT
      If cDigit <> "" And fFrac = 0 Then result = cDigit & LE
      If cDigit = "" And fFrac <> 0 Then result = cFrac & PT
      Monitize = result
      
End Function

Private Function Digit_Translator(X)
Dim n
Dim c
Dim c1
Dim Digit1
Dim c2
Dim Digit2
Dim c3
Dim Digit3
Dim c4
Dim Digit4
Dim c5
Dim Digit5
Dim c6
Dim Digit6

      n = Int(X)
      c = Format(n, "000000000000")
      c1 = Val(Mid(c, 12, 1))
      Select Case c1
            Case Is = 1: Digit1 = "واحد"
            Case Is = 2: Digit1 = "اثنان"
            Case Is = 3: Digit1 = "ثلاث"
            Case Is = 4: Digit1 = "اربع"
            Case Is = 5: Digit1 = "خمس"
            Case Is = 6: Digit1 = "ست"
            Case Is = 7: Digit1 = "سبع"
            Case Is = 8: Digit1 = "ثمان"
            Case Is = 9: Digit1 = "تسع"
      End Select
      
      c2 = Val(Mid(c, 11, 1))
      Select Case c2
            Case Is = 1: Digit2 = "عشر"
            Case Is = 2: Digit2 = "عشرون"
            Case Is = 3: Digit2 = "ثلاثون"
            Case Is = 4: Digit2 = "اربعون"
            Case Is = 5: Digit2 = "خمسون"
            Case Is = 6: Digit2 = "ستون"
            Case Is = 7: Digit2 = "سبعون"
            Case Is = 8: Digit2 = "ثمانون"
            Case Is = 9: Digit2 = "تسعون"
      End Select
      
      If Digit1 <> "" And c2 > 1 Then Digit2 = Digit1 + " و" + Digit2
      If Digit2 = "" Then Digit2 = Digit1
      If c1 = 0 And c2 = 1 Then Digit2 = Digit2 + "ة"
      If c1 = 1 And c2 = 1 Then Digit2 = "احدى عشر"
      If c1 = 2 And c2 = 1 Then Digit2 = "اثنتى عشر"
      If c1 > 2 And c2 = 1 Then Digit2 = Digit1 + " " + Digit2
      c3 = Val(Mid(c, 10, 1))
      Select Case c3
            Case Is = 1: Digit3 = "مائة"
            Case Is = 2: Digit3 = "مئتان"
            Case Is > 2: Digit3 = Left(Digit_Translator(c3), Len(Digit_Translator(c3))) + "مائة"
      End Select
      If Digit3 <> "" And Digit2 <> "" Then Digit3 = Digit3 + " و" + Digit2
      If Digit3 = "" Then Digit3 = Digit2
      
      c4 = Val(Mid(c, 7, 3))
      Select Case c4
            Case Is = 1: Digit4 = "الف"
            Case Is = 2: Digit4 = "الفان"
            Case 3 To 10: Digit4 = Digit_Translator(c4) + " آلاف"
            Case Is > 10: Digit4 = Digit_Translator(c4) + " الف"
      End Select
      If Digit4 <> "" And Digit3 <> "" Then Digit4 = Digit4 + " و" + Digit3
      If Digit4 = "" Then Digit4 = Digit3
      c5 = Val(Mid(c, 4, 3))
      Select Case c5
            Case Is = 1: Digit5 = "مليون"
            Case Is = 2: Digit5 = "مليونان"
            Case 3 To 10: Digit5 = Digit_Translator(c5) + " ملايين"
            Case Is > 10: Digit5 = Digit_Translator(c5) + " مليونا"
      End Select
      If Digit5 <> "" And Digit4 <> "" Then Digit5 = Digit5 + " و" + Digit4
      If Digit5 = "" Then Digit5 = Digit4
      
      c6 = Val(Mid(c, 1, 3))
      Select Case c6
            Case Is = 1: Digit6 = "مليار"
            Case Is = 2: Digit6 = "ملياران"
            Case Is > 2: Digit6 = Digit_Translator(c6) + " مليارات"
      End Select
      If Digit6 <> "" And Digit5 <> "" Then Digit6 = Digit6 + " و" + Digit5
      If Digit6 = "" Then Digit6 = Digit5
      Digit_Translator = Digit6
      
End Function