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

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

الحضرمي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
رابط هذا التعليق
شارك
ناصر سعيد

ناصر سعيد

قام بنشر
قام بنشر 
'صمم بواسطة أ / محمد صالح 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