اذهب الي المحتوي
أوفيسنا

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

شريف ( أبو عبدالرحمن )
 مشاركة
إذهب إلى أفضل إجابة Solved by شريف ( أبو عبدالرحمن ),

الردود الموصى بها

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

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

قام بنشر
قام بنشر

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

  • Like 1
رابط هذا التعليق
شارك
amenbkr

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
  • Like 1
رابط هذا التعليق
شارك
شريف ( أبو عبدالرحمن )

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

قام بنشر
  • الكاتب
قام بنشر

السلام عليكم

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

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

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

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

رابط هذا التعليق
شارك
شريف ( أبو عبدالرحمن )

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

قام بنشر
  • الكاتب
قام بنشر (معدل)

 

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

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  وعملت لصق للكود بس مش عارف أستخدمة أزاي  

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

تم تعديل بواسطه شريف ( أبو عبدالرحمن )
رابط هذا التعليق
شارك
أ / محمد صالح

أ / محمد صالح

قام بنشر
قام بنشر

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

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

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

في ملف واحد

ar_en_tafkeet.rar

  • Like 1
رابط هذا التعليق
شارك
شريف ( أبو عبدالرحمن )

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

قام بنشر
  • الكاتب
قام بنشر

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

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

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

في ملف واحد

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

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

 

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

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

رابط هذا التعليق
شارك
  • أفضل إجابة
شريف ( أبو عبدالرحمن )

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

قام بنشر
  • الكاتب
  • أفضل إجابة
قام بنشر

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

جرب الرقم 101000

 

جرب هذا الملف

 

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

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

رابط هذا التعليق
شارك
أ / محمد صالح

أ / محمد صالح

قام بنشر
قام بنشر

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

جرب الرقم 101000

 

جرب هذا الملف

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

...........

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

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

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

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

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

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

لذا فالصواب

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

أو

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

رابط هذا التعليق
شارك

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.

زائر
اضف رد علي هذا الموضوع....

×   Pasted as rich text.   Paste as plain text instead

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

×
 مشاركة
الذهاب الي قائمه المواضيع

  • تصفح هذا الموضوع مؤخراً   0 اعضاء متواجدين الان

    • لايوجد اعضاء مسجلون يتصفحون هذه الصفحه
×
×
  • اضف...

Important Information

  I accept