الكود : دالة التفقيط فى الاكسيل

لةشىيخ

عضو جديد
إنضم
20 فبراير 2014
المشاركات
1
مجموع الإعجابات
0
النقاط
0
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
 
أعلى