اذهب الي المحتوي
أوفيسنا
بحث مخصص من جوجل فى أوفيسنا
Custom Search

ارجو التكرم واكمال كود تفقيط الدرجات لأكثر من ألف درجة

الحضرمي2017

بواسطه الحضرمي2017
في منتدى الاكسيل Excel

 مشاركة

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

الحضرمي2017

الحضرمي2017

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

السلام عليكم ورحمة الله وبركاته 

ارجو التكرم ومساعدتي في زيادة تفقيط الدرجات لأكثر من الف في هذا الكود بالذات لأنه أعجبني لسهولته وسهولة كتابة الدالة أثناء التفقيط لكن ما يعيبه هو أنه لغاية 999 فقط وأنا اريد التفقيط لاكثر من 1200 درجة فياريت التكرم ومساعدتي بارك الله فيكم 

الملف هو هذا  

https://www.officena.net/ib/applications/core/interface/file/attachment.php?id=45988

 

ناصر سعيد

ناصر سعيد

قام بنشر
قام بنشر 
Function n2t(d As Double) As String
m = Int(d / 100)
h = Int(d / 10) - (m * 10)
a = Int(d - (m * 100 + h * 10))
k = d - (m * 100 + h * 10 + a)
n2t = num((m), 3) & IIf(m > 0 And (a > 0 Or h > 0), " و ", "") & num((a), 1) & IIf(a > 0 And h > 1, " و ", " ") & num((h), 2)
n2t = Replace(n2t, "اثنتانِ عشرة", "اثنتا عشرة")
n2t = Replace(n2t, "ثمانمائة", "ثمنمائة")
n2t = Replace(n2t, "ثلاثمائة", "ثلثمائة")
n2t = Replace(n2t, "و  عشرة", "و عشر")
n2t = IIf(n2t = " عشرة", "عشر", n2t)
n2t = IIf(n2t = "مائتانِ ", "مائتا", n2t)
n2t = "فقط " & n2t & IIf(h = 0 And a = 2, "درجتانِ", IIf((h = 1 And a = 0) Or ((h = 0 And a > 2)), " درجاتٍ", IIf(h = 0 And a = 0, " درجةٍ", " درجةً"))) & IIf(k > 0, " و نصفٌ", "")
n2t = Replace(n2t, "  ", " ")
n2t = Replace(n2t, "إحدى درجةً", "درجةٌ")
n2t = Replace(n2t, "اثنتانِ درجتانِ", "درجتانِ")
End Function
Function num(n As Integer, t As Integer) As String
m = "مائة"
h = "ونَ"
Select Case n
Case Is = 1
num = IIf(t = 3, m, IIf(t = 2, "عشرة", "إحدى"))
Case Is = 2
num = IIf(t = 3, "مائتانِ", IIf(t = 2, "عشرونَ", "اثنتانِ"))
Case Is >= 3
num = IIf(t = 3, nn(n) & m, IIf(t = 2, nn(n) & h, nn(n)))
End Select
End Function
Function nn(n As Integer) As String
Select Case n
Case Is = 3
nn = "ثلاث"
Case Is = 4
nn = "أربع"
Case Is = 5
nn = "خمس"
Case Is = 6
nn = "ست"
Case Is = 7
nn = "سبع"
Case Is = 8
nn = "ثمان"
Case Is = 9
nn = "تسع"
End Select
End Function

هذا هو الكود الموجود في ملف الاخ الكريم ويريد  التفقيط لاكثر من 1200 درجة فياريت التكرم ومساعدته بارك الله فيكم 

  • Thanks 1
الحضرمي2017

الحضرمي2017

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

لو تكرمتم ارجو المساعدة محتاجه ضروري

17 ساعات مضت, ناصر سعيد said: 

Function n2t(d As Double) As String
m = Int(d / 100)
h = Int(d / 10) - (m * 10)
a = Int(d - (m * 100 + h * 10))
k = d - (m * 100 + h * 10 + a)
n2t = num((m), 3) & IIf(m > 0 And (a > 0 Or h > 0), " و ", "") & num((a), 1) & IIf(a > 0 And h > 1, " و ", " ") & num((h), 2)
n2t = Replace(n2t, "اثنتانِ عشرة", "اثنتا عشرة")
n2t = Replace(n2t, "ثمانمائة", "ثمنمائة")
n2t = Replace(n2t, "ثلاثمائة", "ثلثمائة")
n2t = Replace(n2t, "و  عشرة", "و عشر")
n2t = IIf(n2t = " عشرة", "عشر", n2t)
n2t = IIf(n2t = "مائتانِ ", "مائتا", n2t)
n2t = "فقط " & n2t & IIf(h = 0 And a = 2, "درجتانِ", IIf((h = 1 And a = 0) Or ((h = 0 And a > 2)), " درجاتٍ", IIf(h = 0 And a = 0, " درجةٍ", " درجةً"))) & IIf(k > 0, " و نصفٌ", "")
n2t = Replace(n2t, "  ", " ")
n2t = Replace(n2t, "إحدى درجةً", "درجةٌ")
n2t = Replace(n2t, "اثنتانِ درجتانِ", "درجتانِ")
End Function
Function num(n As Integer, t As Integer) As String
m = "مائة"
h = "ونَ"
Select Case n
Case Is = 1
num = IIf(t = 3, m, IIf(t = 2, "عشرة", "إحدى"))
Case Is = 2
num = IIf(t = 3, "مائتانِ", IIf(t = 2, "عشرونَ", "اثنتانِ"))
Case Is >= 3
num = IIf(t = 3, nn(n) & m, IIf(t = 2, nn(n) & h, nn(n)))
End Select
End Function
Function nn(n As Integer) As String
Select Case n
Case Is = 3
nn = "ثلاث"
Case Is = 4
nn = "أربع"
Case Is = 5
nn = "خمس"
Case Is = 6
nn = "ست"
Case Is = 7
nn = "سبع"
Case Is = 8
nn = "ثمان"
Case Is = 9
nn = "تسع"
End Select
End Function

هذا هو الكود الموجود في ملف الاخ الكريم ويريد  التفقيط لاكثر من 1200 درجة فياريت التكرم ومساعدته بارك الله فيكم 

ياريت احد يساعد لو تكرمتم 

تم تعديل بواسطه الحضرمي2017
أ / محمد صالح

أ / محمد صالح

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

السلام عليكم ورحمة الله وبركاته

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

فالمنتدى مليء بالدرر

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

أصلح الله أحوالنا وأحوالكم في اليمن الشقيق

تفقيط الدرجات حتى 9999.5

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

أحتاج دعاءكم لي بصلاح النفس وسعة الرزق

وفقنا الله وإياكم لكل خير

تفقيط الدرجات.zip

  • Like 2
الحضرمي2017

الحضرمي2017

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

جزاك الله خير الجزاء اللهم يسر أمره ووسع رزقه واعنه على طاعتك وخدمة عبادك

تم تعديل بواسطه الحضرمي2017
ناصر سعيد

ناصر سعيد

قام بنشر
قام بنشر 
'صمم بواسطة أ / محمد صالح 10/2/2011
'تم التعديل لإضافة الصفر والنصف 28/4/2015
'تم التعديل للوصول إلى 9999 والسماح بكتابة غ للغياب في 27/11/2017
' https://a1mas.com
Function n2t(d As String) As String
If d = "" Or d = "غ" Then
n2t = "غ"
ElseIf d = 0 Or d > 9999.5 Then
n2t = "لا شيء"
ElseIf d = 0.5 Then
n2t = "فقط نصف درجة"
Else
o = Int(d / 1000)
m = Int(d / 100) - (o * 10)
h = Int(d / 10) - (o * 100 + m * 10)
a = Int(d - (o * 1000 + m * 100 + h * 10))
k = d - (o * 1000 + m * 100 + h * 10 + a)
n2t = num((o), 4) & IIf(o > 0 And (a > 0 Or h > 0 Or m > 0), " و", "") & num((m), 3) & IIf(m > 0 And (a > 0 Or h > 0), " و", "") & num((a), 1) & IIf(a > 0 And h > 1, " و", " ") & num((h), 2)
n2t = Replace(n2t, "و ", "و")
n2t = Replace(n2t, "اثنتانِ عشرة", "اثنتا عشرة")
n2t = Replace(n2t, "وعشرة", "وعشر")
n2t = IIf(n2t = " عشرة", "عشر", n2t)
n2t = IIf(n2t = "مائتانِ ", "مائتا", n2t)
n2t = IIf(n2t = "ألفان ", "ألفا", n2t)
n2t = "فقط " & n2t & IIf(h = 0 And a = 2, "درجتانِ", IIf((h = 1 And a = 0) Or ((h = 0 And a > 2)), " درجاتٍ", IIf(h = 0 And a = 0, " درجةٍ", " درجةً"))) & IIf(k > 0, " ونصفٌ", "")
n2t = Replace(n2t, "إحدى  درجةً", "درجةٌ")
n2t = Replace(n2t, "اثنتانِ درجتانِ", "درجتانِ")
n2t = Replace(n2t, "مائتانِ  درجةٍ", "مائتا درجةٍ")
End If
n2t = Trim(n2t)
End Function
Function num(n As Integer, t As Integer) As String
o = "ة آلاف"
m = "مائة"
h = "ونَ"
Select Case n
Case Is = 1
num = IIf(t = 4, "ألف", IIf(t = 3, m, IIf(t = 2, "عشرة", "إحدى")))
Case Is = 2
num = IIf(t = 4, "ألفان", IIf(t = 3, "مائتانِ", IIf(t = 2, "عشرونَ", "اثنتانِ")))
Case Is >= 3
num = IIf(t = 4, nn(n) & o, IIf(t = 3, nn(n) & m, IIf(t = 2, nn(n) & h, nn(n))))
End Select
End Function
Function nn(n As Integer) As String
Select Case n
Case Is = 3
nn = "ثلاث"
Case Is = 4
nn = "أربع"
Case Is = 5
nn = "خمس"
Case Is = 6
nn = "ست"
Case Is = 7
nn = "سبع"
Case Is = 8
nn = "ثمان"
Case Is = 9
nn = "تسع"
End Select
End Function

الكود بعد التعديل للمحترم محمد صالح

رزقه الله الرزق الواسع ونحن معه 

وان يصلح الله حاله وحالنا ..

  • Like 1
  • 1 month later...
Mohamed kalawa

Mohamed kalawa

قام بنشر
قام بنشر
On 27/11/2017 at 8:39 PM, الحضرمي2017 said:

جزاك الله خير الجزاء اللهم يسر أمره ووسع رزقه واعنه على طاعتك وخدمة عبادك

لو تكرمت اخى الكريم لا استطيع اضافة الكود  على اكسيل ٢٠١٦ فهو لا يلصق العربية 

لو تكرمت اخى الكريم لا استطيع اضافة الكود  على اكسيل ٢٠١٦ فهو لا يلصق العربية 

 
الحضرمي2017

الحضرمي2017

قام بنشر
  • الكاتب
قام بنشر
في ٣‏/١‏/٢٠١٨ at 15:14, Mohamed kalawa said:

لو تكرمت اخى الكريم لا استطيع اضافة الكود  على اكسيل ٢٠١٦ فهو لا يلصق العربية 

لو تكرمت اخى الكريم لا استطيع اضافة الكود  على اكسيل ٢٠١٦ فهو لا يلصق العربية 

     بسيطة أخي الحبيب كل ماعليك هو تحويل اللغة العربية في الجهاز بالضغط على alt+shift  قبل النسخ وبعدها انسخ الكود ثم روح على الاكسل والصق ويضبط باذن الله حصلت معي وفعلت هكذا ونجح الامر

انشئ حساب جديد او قم بتسجيل دخولك لتتمكن من اضافه تعليق جديد

يجب ان تكون عضوا لدينا لتتمكن من التعليق

انشئ حساب جديد

سجل حسابك الجديد لدينا في الموقع بمنتهي السهوله .

سجل حساب جديد

تسجيل دخول

هل تمتلك حساب بالفعل ؟ سجل دخولك من هنا.

سجل دخولك الان
 مشاركة
الذهاب الي قائمه المواضيع
×
×
  • اضف...

Important Information

  I accept