دالة (لتفقيط) مبلغ الفاتورة مباشرة

[شريف ( أبو عبدالرحمن )]

السادة أعضاء المنتدى المحترمون , هل يوجد داله لتفقيط مبلغ الفاتورة مباشرة ولو تفقيط عربي وإنجليزي , يبقى جزاكم الله خيراً مثلاُ 1,200,000,85 بالعربي ( فقط مليون ومائتان ألف جنيه , 85/ 100 لاغير ) &&& ولو المبلغ بالدولار ( Only one Milion and Two thousand dollar and 85 cents )

[علي الشيخ]

السلام عليكم

أخي الفاضل شوف المرفق لعله يكون قريب إلى حد ما من المطلوب

 

Test.rar

[amenbkr]

اخي الكريم هذا كود للتفقيط بالعربي

Function tafket(Number, Curncey, txtdec)

Dim dec As Currency

If Not IsNumeric(Number) Or Number = "" Or Len(Int(Number)) > 10 Then Exit Function

'If Len(Int(Number)) > 10 Then MsgBox "max 10 numbers": Exit Function

dec = Number - Int(Val(Number))

ST = Trim(Str(Int(Number)))

xol = Len(ST)

wa = " و "

vn = Val(ST)

Select Case xol

Case 1

     ct = AHAD(vn)

Case 2

     ct = ASHRAT(vn)

Case 3

     ct = MIAT(vn)

Case 4

     vn4 = Val(Mid(ST, 1, 1))

     Select Case vn4

       Case 1

        ct = "ألف"

       Case 2

        ct = "ألفين"

       Case Else

        ct = AHAD(vn4) & " آلاف "

     End Select

     vn4 = Val(Mid(ST, 2, 3))

     ct = ct & IIf(vn4 > 99, wa, "") & MIAT(vn4)

Case 5

     vn5 = Val(Mid(ST, 1, 2))

     ct = IIf(vn5 = 10, ASHRAT(vn5) & " آلاف ", ASHRAT(vn5) & " ألف")

     vn5 = Val(Mid(ST, 3, 3))

     ct = ct & IIf(vn5 > 99, wa, "") & MIAT(vn5)

Case 6

     VN6 = Val(Mid(ST, 1, 3))

     ct = MIAT(VN6)

     VN6 = Val(Mid(ST, 4, 3))

     ct = ct & " ألف " & IIf(VN6 > 99, wa, "") & MIAT(VN6)

Case 7

     vn = Val(Mid(ST, 1, 1))

     Select Case vn

       Case 1

        ct = "مليون "

       Case 2

        ct = "مليونين "

       Case Else

        ct = IIf(vn > 0, AHAD(vn), "") & " ملايين "

    End Select

     vn = Val(Mid(ST, 2, 3))

     ct = ct & IIf(vn > 99, wa, "") & IIf(vn > 0, MIAT(vn) & " ألف ", "")

     vn = Val(Mid(ST, 5, 3))

     ct = ct & IIf(vn > 99, "و", "") & MIAT(vn)

Case 8

   vn = Val(Mid(ST, 1, 2))

   ct = ASHRAT(vn) & " مليون "

   ct = IIf(vn = 10, ASHRAT(vn) & " ملايين ", ct)

   vn = Val(Mid(ST, 3, 3))

   ct = ct & IIf(vn > 99, wa, "") & IIf(vn > 0, MIAT(vn) & " ألف ", "")

   vn = Val(Mid(ST, 6, 3))

   ct = ct & IIf(vn > 99, wa, "") & MIAT(vn)

Case 9

   vn = Val(Mid(ST, 1, 3))

   ct = MIAT(vn) & " مليون "

   vn = Val(Mid(ST, 4, 3))

   ct = ct & IIf(vn > 99, wa, "") & IIf(vn > 0, MIAT(vn) & " الف ", "")

   vn = Val(Mid(ST, 7, 3))

   ct = ct & IIf(vn > 99, wa, "") & MIAT(vn)

Case 10

     vn = Val(Mid(ST, 1, 1))

     Select Case vn

       Case 1

        ct = "مليار "

       Case 2

        ct = "مليارين "

       Case Else

        ct = IIf(vn > 0, AHAD(vn), "") & " مليار"

    End Select

    vn = Val(Mid(ST, 2, 3))

   ct = ct & IIf(vn > 99, wa, "") & IIf(vn > 0, MIAT(vn) & " مليون ", "")

   vn = Val(Mid(ST, 5, 3))

   ct = ct & IIf(vn > 99, wa, "") & IIf(vn > 0, MIAT(vn) & " الف ", "")

   vn = Val(Mid(ST, 8, 3))

   ct = ct & IIf(vn > 99, wa, "") & MIAT(vn)

End Select

ct = " فقط " & ct & " " & Curncey & " " & IIf(Val(dec) > 0, wa & (dec * 100) & txtdec, "") & " لاغير"

If Val(Number) = 0 Then ct = "صفر"

'ct = "فقط " & ct & " " & Curncey & " " & IIf(Val(dec) > 0, wa & (dec * 100) & " " & CRNCY2, "") & " لاغير"

tafket = ct

 

End Function

 

Function MIAT(NUM3)

vn3 = Int(NUM3 / 100)

Select Case vn3

   Case 1

      HARF3 = "مائة"

   Case 2

      HARF3 = "مئتان"

   Case 3 To 9

     HARF3 = AHAD(vn3)

     F = "ة"

     B = ""

     D = "ية"

     If vn3 = 8 Then

      HARF3 = Left(HARF3, Len(HARF3) - 2) & "مائة"

     Else

      HARF3 = Left(HARF3, Len(HARF3) - 1) & "مائة"

     End If

   Case Else

      HARF3 = ""

End Select

vn3 = NUM3 - vn3 * 100

If Val(Right(vn3, 1)) = 0 Then wa = " " Else: wa = " و "

 HARF3 = HARF3 & IIf(vn3 > 0, wa & IIf(vn3 < 10, AHAD(vn3), ASHRAT(vn3)), "")

MIAT = HARF3

End Function

 

Function ASHRAT(NUM2)

wa = " و "

vn2 = Int(NUM2 / 10)

 Select Case NUM2

     Case 10

       HARF2 = "عشرة"

     Case 11

       HARF2 = "إحدى عشر"

     Case 12

       HARF2 = "إثنى عشر"

     Case 13 To 19

       HARF2 = IIf(NUM2 * (10 / 100) <> 0, AHAD(Right(NUM2, 1)) & " ", "") & " عشر"

   End Select

 

   Select Case vn2

       Case 2

       HARF2 = IIf(AHAD(Right(NUM2, 1)) <> "", AHAD(Right(NUM2, 1)) & wa, "") & " عشرون"

     Case 3

       HARF2 = IIf(AHAD(Right(NUM2, 1)) <> "", AHAD(Right(NUM2, 1)) & wa, "") & " ثلاثون"

    Case 4

        HARF2 = AHAD(Right(NUM2, 1)) & IIf(AHAD(Right(NUM2, 1)) <> "", wa, "") & " أربعون"

     Case 5

        HARF2 = AHAD(Right(NUM2, 1)) & IIf(AHAD(Right(NUM2, 1)) <> "", wa, "") & " خمسون"

     Case 6

        HARF2 = AHAD(Right(NUM2, 1)) & IIf(AHAD(Right(NUM2, 1)) <> "", wa, "") & " ستون"

     Case 7

        HARF2 = AHAD(Right(NUM2, 1)) & IIf(AHAD(Right(NUM2, 1)) <> "", wa, "") & " سبعون"

     Case 8

        HARF2 = AHAD(Right(NUM2, 1)) & IIf(AHAD(Right(NUM2, 1)) <> "", wa, "") & " ثمانون"

     Case 9

        HARF2 = AHAD(Right(NUM2, 1)) & IIf(AHAD(Right(NUM2, 1)) <> "", wa, "") & " تسعون"

 End Select

 ASHRAT = HARF2

End Function

 

Function AHAD(num1)

 Select Case num1

    Case 0

       harf1 = ""

    Case 1

        harf1 = "واحد"

    Case 2

        harf1 = "إثنان"

    Case 3

        harf1 = "ثلاثة"

    Case 4

        harf1 = "أربعة"

    Case 5

        harf1 = "خمسة"

    Case 6

        harf1 = "ستة"

    Case 7

        harf1 = "سبعة"

    Case 8

        harf1 = "ثمانية"

    Case 9

        harf1 = "تسعة"

  End Select

AHAD = harf1

End Function

[شريف ( أبو عبدالرحمن )]

السلام عليكم

أخي الفاضل شوف المرفق لعله يكون قريب إلى حد ما من المطلوب

ما شاء الله لا قوة إلا بالله - ربنا يبارك لك في علمك يا أخي 

أكثر أكثر أكثر من رائع 

( اللهم بارك في علم أخي على الشيخ ) 

[شريف ( أبو عبدالرحمن )]

 

اخي الكريم هذا كود للتفقيط بالعربي

Function tafket(Number, Curncey, txtdec)

Dim dec As Currency

If Not IsNumeric(Number) Or Number = "" Or Len(Int(Number)) > 10 Then Exit Function

'If Len(Int(Number)) > 10 Then MsgBox "max 10 numbers": Exit Function

dec = Number - Int(Val(Number))

ST = Trim(Str(Int(Number)))

xol = Len(ST)

wa = " و "

vn = Val(ST)

Select Case xol

Case 1

     ct = AHAD(vn)

Case 2

     ct = ASHRAT(vn)

Case 3

     ct = MIAT(vn)

Case 4

     vn4 = Val(Mid(ST, 1, 1))

     Select Case vn4

       Case 1

        ct = "ألف"

       Case 2

        ct = "ألفين"

       Case Else

        ct = AHAD(vn4) & " آلاف "

     End Select

     vn4 = Val(Mid(ST, 2, 3))

     ct = ct & IIf(vn4 > 99, wa, "") & MIAT(vn4)

Case 5

     vn5 = Val(Mid(ST, 1, 2))

     ct = IIf(vn5 = 10, ASHRAT(vn5) & " آلاف ", ASHRAT(vn5) & " ألف")

     vn5 = Val(Mid(ST, 3, 3))

     ct = ct & IIf(vn5 > 99, wa, "") & MIAT(vn5)

Case 6

     VN6 = Val(Mid(ST, 1, 3))

     ct = MIAT(VN6)

     VN6 = Val(Mid(ST, 4, 3))

     ct = ct & " ألف " & IIf(VN6 > 99, wa, "") & MIAT(VN6)

Case 7

     vn = Val(Mid(ST, 1, 1))

     Select Case vn

       Case 1

        ct = "مليون "

       Case 2

        ct = "مليونين "

       Case Else

        ct = IIf(vn > 0, AHAD(vn), "") & " ملايين "

    End Select

     vn = Val(Mid(ST, 2, 3))

     ct = ct & IIf(vn > 99, wa, "") & IIf(vn > 0, MIAT(vn) & " ألف ", "")

     vn = Val(Mid(ST, 5, 3))

     ct = ct & IIf(vn > 99, "و", "") & MIAT(vn)

Case 8

   vn = Val(Mid(ST, 1, 2))

   ct = ASHRAT(vn) & " مليون "

   ct = IIf(vn = 10, ASHRAT(vn) & " ملايين ", ct)

   vn = Val(Mid(ST, 3, 3))

   ct = ct & IIf(vn > 99, wa, "") & IIf(vn > 0, MIAT(vn) & " ألف ", "")

   vn = Val(Mid(ST, 6, 3))

   ct = ct & IIf(vn > 99, wa, "") & MIAT(vn)

Case 9

   vn = Val(Mid(ST, 1, 3))

   ct = MIAT(vn) & " مليون "

   vn = Val(Mid(ST, 4, 3))

   ct = ct & IIf(vn > 99, wa, "") & IIf(vn > 0, MIAT(vn) & " الف ", "")

   vn = Val(Mid(ST, 7, 3))

   ct = ct & IIf(vn > 99, wa, "") & MIAT(vn)

Case 10

     vn = Val(Mid(ST, 1, 1))

     Select Case vn

       Case 1

        ct = "مليار "

       Case 2

        ct = "مليارين "

       Case Else

        ct = IIf(vn > 0, AHAD(vn), "") & " مليار"

    End Select

    vn = Val(Mid(ST, 2, 3))

   ct = ct & IIf(vn > 99, wa, "") & IIf(vn > 0, MIAT(vn) & " مليون ", "")

   vn = Val(Mid(ST, 5, 3))

   ct = ct & IIf(vn > 99, wa, "") & IIf(vn > 0, MIAT(vn) & " الف ", "")

   vn = Val(Mid(ST, 8, 3))

   ct = ct & IIf(vn > 99, wa, "") & MIAT(vn)

End Select

ct = " فقط " & ct & " " & Curncey & " " & IIf(Val(dec) > 0, wa & (dec * 100) & txtdec, "") & " لاغير"

If Val(Number) = 0 Then ct = "صفر"

'ct = "فقط " & ct & " " & Curncey & " " & IIf(Val(dec) > 0, wa & (dec * 100) & " " & CRNCY2, "") & " لاغير"

tafket = ct

 

End Function

 

Function MIAT(NUM3)

vn3 = Int(NUM3 / 100)

Select Case vn3

   Case 1

      HARF3 = "مائة"

   Case 2

      HARF3 = "مئتان"

   Case 3 To 9

     HARF3 = AHAD(vn3)

     F = "ة"

     B = ""

     D = "ية"

     If vn3 = 8 Then

      HARF3 = Left(HARF3, Len(HARF3) - 2) & "مائة"

     Else

      HARF3 = Left(HARF3, Len(HARF3) - 1) & "مائة"

     End If

   Case Else

      HARF3 = ""

End Select

vn3 = NUM3 - vn3 * 100

If Val(Right(vn3, 1)) = 0 Then wa = " " Else: wa = " و "

 HARF3 = HARF3 & IIf(vn3 > 0, wa & IIf(vn3 < 10, AHAD(vn3), ASHRAT(vn3)), "")

MIAT = HARF3

End Function

 

Function ASHRAT(NUM2)

wa = " و "

vn2 = Int(NUM2 / 10)

 Select Case NUM2

     Case 10

       HARF2 = "عشرة"

     Case 11

       HARF2 = "إحدى عشر"

     Case 12

       HARF2 = "إثنى عشر"

     Case 13 To 19

       HARF2 = IIf(NUM2 * (10 / 100) <> 0, AHAD(Right(NUM2, 1)) & " ", "") & " عشر"

   End Select

 

   Select Case vn2

       Case 2

       HARF2 = IIf(AHAD(Right(NUM2, 1)) <> "", AHAD(Right(NUM2, 1)) & wa, "") & " عشرون"

     Case 3

       HARF2 = IIf(AHAD(Right(NUM2, 1)) <> "", AHAD(Right(NUM2, 1)) & wa, "") & " ثلاثون"

    Case 4

        HARF2 = AHAD(Right(NUM2, 1)) & IIf(AHAD(Right(NUM2, 1)) <> "", wa, "") & " أربعون"

     Case 5

        HARF2 = AHAD(Right(NUM2, 1)) & IIf(AHAD(Right(NUM2, 1)) <> "", wa, "") & " خمسون"

     Case 6

        HARF2 = AHAD(Right(NUM2, 1)) & IIf(AHAD(Right(NUM2, 1)) <> "", wa, "") & " ستون"

     Case 7

        HARF2 = AHAD(Right(NUM2, 1)) & IIf(AHAD(Right(NUM2, 1)) <> "", wa, "") & " سبعون"

     Case 8

        HARF2 = AHAD(Right(NUM2, 1)) & IIf(AHAD(Right(NUM2, 1)) <> "", wa, "") & " ثمانون"

     Case 9

        HARF2 = AHAD(Right(NUM2, 1)) & IIf(AHAD(Right(NUM2, 1)) <> "", wa, "") & " تسعون"

 End Select

 ASHRAT = HARF2

End Function

 

Function AHAD(num1)

 Select Case num1

    Case 0

       harf1 = ""

    Case 1

        harf1 = "واحد"

    Case 2

        harf1 = "إثنان"

    Case 3

        harf1 = "ثلاثة"

    Case 4

        harf1 = "أربعة"

    Case 5

        harf1 = "خمسة"

    Case 6

        harf1 = "ستة"

    Case 7

        harf1 = "سبعة"

    Case 8

        harf1 = "ثمانية"

    Case 9

        harf1 = "تسعة"

  End Select

AHAD = harf1

End Function

 

أخي وحبيبي , هل من الممكن عمل مثال لشيت أكسيل  وتضع فيه هذا الكود -

أنا عملت شيت جديد ودوست Alt+ F11  وعملت لصق للكود بس مش عارف أستخدمة أزاي  

وجزاك الله خيراً على المساعدة 

تم تعديل مايو 20, 2015 بواسطه شريف ( أبو عبدالرحمن )

[أ / محمد صالح]

تفضل أخي الكريم

هذا الملف من أفضل مقنياتي

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

في ملف واحد

ar_en_tafkeet.rar

[ياسر خليل أبو البراء]

أخي الحبيب محمد صالح

جرب الرقم 101000

 

جرب هذا الملف

Tafket UDF Function.rar

[شريف ( أبو عبدالرحمن )]

تفضل أخي الكريم

هذا الملف من أفضل مقنياتي

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

في ملف واحد

بسم الله ما شاء الله لا قوة إلا بالله 

رائــــــع جداً , هذا بالظبط ما كنت أبحث عنه           

 

اللهم بارك في أخي محمد صالح وفي أهله وذريته إلي يوم الدين ,, اللهم أمين

جزاك الله خيراً 

[شريف ( أبو عبدالرحمن )]

أخي الحبيب محمد صالح

جرب الرقم 101000

 

جرب هذا الملف

 

اللهم بارك , فعلاً مجهود رائع 

جزاكم الله خيراً 

[أ / محمد صالح]

أخي الحبيب محمد صالح

جرب الرقم 101000

 

جرب هذا الملف

ماذا بعد التجربة أخي ياسر؟!

...........

بعد فتحي للملف المرفق من سيادتكم

اتضح لي عدم موافقته لقواعد اللغة العربية

فلا يقال: مائة وواحد ألف جنيه

لأننا لا نقول مثلا 1300 واحد ألف وثلاثمائة

وإنما نقول: ألف وثلاثمائة

............

لذا فالصواب

مائة وألف جنيه

أو

مائة ألف وألف جنيه