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

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

بسم الله الرحمن الرحيم

كيف الحال أحبابي في الله

إن شاء الله بخير وسعادة ورضا

كل عام أنتم جميعا بخير

نلتقي من جديد في شهر ميلاد سيد الخلق

وهديتي لكم بمناسبة المولد النبوي الشريف هي

**********

بناء على طلب الأخ الفاضل @عبدالرحمن وسلمى

قمت بعمل دالة معرفة لجلب ناتج التفقيط الموجود في الموقع الشخصي لي

https://a1mas.com/التفقيط-تحويل-الأرقام-لكلمات-عربية/

إلى ملف إكسل أو أكسس

بشرط الاتصال بالانترنت

==============

الجميل في الصفحة أنها تراعي بإذن الله

كل قواعد صياغة العدد في اللغة العربية

ولا تحتوي على أخطاء إملائية ولا نحوية

وتمت برمجتها بلغة php لأني لم أجد من المرونة في لغة فيجوال بيسك للتطبيقات vba ما يسمح بنفس البرمجة المستخدمة في لغة الويب php

لذا تم التحايل على الأمر بكود

يقوم بطلب الصفحة الخاصة بالتفقيط وتمرير البيانات الخاصة بنا من صفحة الإكسل إلى الموقع

ثم يسجل ما يعود به الموقع في الخلية

============

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

والآن أترككم مع الملف

 

التفقيط من الانترنت.rar

[الحضرمي2017 0]

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

 

أستاذي الفاضل هل لك أن تتكرم وتساعدني وتعدل على كود التفقيط الذي وضعتها أنت في أحد ردودك على أحد الاخوة وبالصراحة أعجبني جدا لسهولته وسهولة كتابة الدالة في خلايا الاكسل لكن المشكلة أنه لا يفقط إلا الى 999 وأنا محتاج إليه واريد التفقط لأكثر من 1200 درجة لأني استخدمه في ملف خاص بالثانوية لذا ارجو التكرم ومساعدتي بارك الله فيك وفي علمك ونفع بك الاسلام والمسلمين

 

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

 

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

شكرا لتواصلك أخي الكريم

إن شاء الله سيتم فتح موضوع جديد بهذا الخصوص

ولكن لم تخبرنا برأيك في الموضوع المنشور

[الحضرمي2017 0]

استاذي الفاضل انا ابديت اعجابي بالدالة التي وضعتها وكتبت موضوع طالبا فيه المساعدة في اكمال دالة التفقيط التي كتبتها أنت وقلت فيه أني وجدتها أفضل دالة والله لتطابقها مع القواعد ولسهولة كتابتها في خلايا الاكسل فأغلب الدوال تكتب فيها عدت شروط 

وبالنسبة لما قمت به من جعل الدالة تقرأ من النت فهذا قمت الابداع والتألق فجزاك الله خير الجزاء لكن يعلم الله أنني بحاجة للكود لأن النت عندنا والكهرباء كذلك لا تسعفني في استخدام دالة التفقيط من الانترنت والقراءة من موقع التفقيط الذي أنشأته فهو صرح نادر خاصة إذا كان مصممه متقن لقواعد اللغة ومتقن للبرمجة بالصراحة والله أبهرني والله 

خاصة وأن التفقيط كان بالحركات المناسبة مثلا يقرأ العدد 33  ثلاثٌ وثلاثونَ درجةٌ 

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

[ناصر سعيد 255]

لا حرمك الله الاجر وجعله في ميزان حسناتك  استاذ محمد صالح

 

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

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

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

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

=====

=n2t(A1)

هذه الجمله هي التي تكتب في صفحه ااكسيل وتكتب الارقام في الخليه A1  على سبيل  المثال

اخي الكريم

انه يقرب الارقام بطريقه غير مفهومه

 

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

المطلوب من الكود هو تفقيط الدرجة والنصف فقط

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

خمس وعشرون درجة و عشر أحزاء

على أساس أن المعدود درجة والكسر جزء

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

هذه حكاية هذا الكود أنه لا يوجد اسم للكسر

وإنما كان المطلوب أي كسر يتم تحويله لنصف

 

[العبد الفقير إلى الله تعالى 511]

بسم الله الرحمن الرحيم

وبه نستعين

اخى وحبيبى فى الله ابو صالح

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

اود فى البداية وقبل تحميل المرفق ان تتقبل اعتذراى الشديد

لعدم الرد فى حينة لظروف خارجة عن إرادتى

ثانيا اشكرك من صميم قلبى على هذة اللفتة الطيبة المباركة

النى احتسبها ان شاء الله تعالى فى موازيين حسناتك يوم القيامة

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

بعد تجربة المرفق على الملف الاصلى الذى أرغب العمل عليه على اعتبار ان التجربة جديدة من نوعها

وفقنا الله واياكم الى مايحبة ويرضاه

تقبل وافر تقديرى واحترامى وجزاكم الله خيرا

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

شكرا لمروركم الكريم

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