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

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

Recommended Posts

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

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

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

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

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

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

**********

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

 

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

  • Like 1
  • Thanks 1

شارك هذه المشاركه


رابط المشاركه
شارك

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

 

أستاذي الفاضل هل لك أن تتكرم وتساعدني وتعدل على كود التفقيط الذي وضعتها أنت في أحد ردودك على أحد الاخوة وبالصراحة أعجبني جدا لسهولته وسهولة كتابة الدالة في خلايا الاكسل لكن المشكلة أنه لا يفقط إلا الى 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

 

شارك هذه المشاركه


رابط المشاركه
شارك

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

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

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

:rol:

  • Like 1

شارك هذه المشاركه


رابط المشاركه
شارك

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

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

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

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

شارك هذه المشاركه


رابط المشاركه
شارك

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

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

اخي الكريم

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

 

11.png

شارك هذه المشاركه


رابط المشاركه
شارك

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

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

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

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

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

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

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

 

  • Like 1

شارك هذه المشاركه


رابط المشاركه
شارك

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

وبه نستعين

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

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

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

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

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

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

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

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

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

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

شارك هذه المشاركه


رابط المشاركه
شارك

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

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

شارك هذه المشاركه


رابط المشاركه
شارك

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

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

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

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

سجل حساب جديد

تسجيل دخول

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

سجل دخولك الان

  • محتوي مشابه

    • بواسطه ناصرالمصرى
      السلام عليكم ورحمته الله وبركاته
      هناك خلل ما فى عمل هذا الكود وهو لتفقيط المبالغ 
      حاولت معرفة  سبب هذا الخلل حيث رسائل الخطأ لكنى فشلت فى ذلك
      فضلا لا أمرا  أرجو  من حضراتكم الاطلاع على المرفق التالى لتصويب ما يمكن تصويبه
      شاكر فضل حضراتكم وجزاكم الله خيرا
      تفقيط.xlsm
    • بواسطه عبد الفتاح كيرة
      السلام عليكم
      تظهر هذه الرسالة عند محاولة فتح محرر الأكواد لكتابة كود
      فما سببها
      وهذا فى ملف واحد بسيط
      وتفتح مع ملفات أخرى

    • بواسطه amenbkr
      السلام عليكم
      اخواني اريد تفقيط الارقام ولكن باللغة التركية بحثت بالنت ووجدت هذه المعادلة ولكن لا تظهر القروش  وعند كتاية الرقم مع الفروش لا يظهر الكتابة ارجو المساعدة
      try.xlsm
    • بواسطه أ / محمد صالح
      اعرض الملف الدليل الشامل في حساب مدد خدمة الموظفين وإجمالي هذه المدد
      بسم الله الرحمن الرحيم السلام عليكم ورحمة الله وبركاته ================ كثرت الأسئلة في الفترة الأخيرة حول حساب الفرق بن تاريخين ويستخدم هذا في حساب مدة خدمة الموظفين من تاريخ التعيين إلى الآن
      وكذلك مدد الخدمة الإضافية
      وكذلك مدد الانقطاع عن العمل
      -------------------------------------- ولذلك توكلت على الله وقمت بتصميم هذا الملف
      لعله يفيد كل من يبحث في هذا الموضوع
      والله من وراء القصد
      ولا ينقصني سوى دعاؤكم
      ............
      تم تحديث البرنامج وإجراء بعض التعديلات
      صاحب الملف أ / محمد صالح تمت الاضافه 13 نوف, 2011 الاقسام قسم الأكسيس  
    • بواسطه أ / محمد صالح
      بسم الله الرحمن الرحيم السلام عليكم ورحمة الله وبركاته ================ كثرت الأسئلة في الفترة الأخيرة حول حساب الفرق بن تاريخين ويستخدم هذا في حساب مدة خدمة الموظفين من تاريخ التعيين إلى الآن
      وكذلك مدد الخدمة الإضافية
      وكذلك مدد الانقطاع عن العمل
      -------------------------------------- ولذلك توكلت على الله وقمت بتصميم هذا الملف
      لعله يفيد كل من يبحث في هذا الموضوع
      والله من وراء القصد
      ولا ينقصني سوى دعاؤكم
      ............
      تم تحديث البرنامج وإجراء بعض التعديلات
  • المتواجدين الان   0 اعضاء متواجدين الان

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

×