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

العودة   منتدى مجمع التطوير > المنتدى المتخصص > لغـات البرمجـة والمشـاريع الجـاهزة > برامج Microsoft Office

الملاحظات

برامج Microsoft Office يهتم ببرامج الميكروسوفت اوفيس ,excel ,access, word Frontpage,powerpoint ,outlook,

آخر 10 مشاركات ملف ال robots.txt وتوجيه عناكب محركات البحث لموقعك (الكاتـب : admin - مشاركات : 2 - المشاهدات : 250 - الوقت: 01:24 PM - التاريخ: 07-21-2021)           »          أهلا وسهلا أليت تيم رياك (الكاتـب : رياك مشار - مشاركات : 2 - المشاهدات : 178 - الوقت: 05:58 PM - التاريخ: 07-03-2021)           »          تحميل لعبة فرايدي نايت فانكن Friday Night Funkin للكمبيوتر 2021 (الكاتـب : الادارة كريم - آخر مشاركة : admin - مشاركات : 2 - المشاهدات : 418 - الوقت: 10:41 PM - التاريخ: 07-01-2021)           »          برنامج البيع بالتقسيط مجاني مصمم بالاكسيس (الكاتـب : ابن الوليد - آخر مشاركة : admin - مشاركات : 1 - المشاهدات : 560 - الوقت: 04:37 AM - التاريخ: 06-25-2021)           »          الصحابي الجليل سعد بن معاذ الأنصاري (الكاتـب : admin - مشاركات : 0 - المشاهدات : 206 - الوقت: 01:25 AM - التاريخ: 06-25-2021)           »          كيفية صلاة الحاجة (الكاتـب : admin - مشاركات : 0 - المشاهدات : 201 - الوقت: 12:13 AM - التاريخ: 06-25-2021)           »          Format FactoryV5.7.5.0 (الكاتـب : admin - مشاركات : 0 - المشاهدات : 229 - الوقت: 11:01 PM - التاريخ: 06-24-2021)           »          رجل أقسم بأن لا يتزوج حتى يشاور مائة رجل (الكاتـب : admin - مشاركات : 0 - المشاهدات : 230 - الوقت: 09:57 PM - التاريخ: 06-24-2021)           »          سلاحف الننجا2 (الكاتـب : admin - مشاركات : 2 - المشاهدات : 360 - الوقت: 02:31 AM - التاريخ: 06-22-2021)           »          كيفية عمل رسم بياني في Excel وإضافة مرئيات إلى تقاريرك (الكاتـب : الادارة كريم - آخر مشاركة : admin - مشاركات : 1 - المشاهدات : 219 - الوقت: 04:56 PM - التاريخ: 06-21-2021)

إضافة رد
 
أدوات الموضوع انواع عرض الموضوع
  #1  
قديم 04-26-2021, 07:30 PM
الصورة الرمزية ابن الوليد
ابن الوليد 
::..مشرف برامج مايكروسوفت..::
 
تاريخ التسجيل: Mar 2021
الدولة: مصر
المشاركات: 160
معدل تقييم المستوى: 16
ابن الوليد is a splendid one to beholdابن الوليد is a splendid one to beholdابن الوليد is a splendid one to beholdابن الوليد is a splendid one to beholdابن الوليد is a splendid one to beholdابن الوليد is a splendid one to beholdابن الوليد is a splendid one to behold


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

 

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




كود:
Option Explicit
'========================================================"
'                بسم الله الرحمن الرحيم                     "
'========================================================"
'      (دالة تحويل الرقم الى نص باللغة العربية (تفقيط      "
'                     kh_TextNum                         "
'========================================================"
'Num                     الرقم                           "
'========================================================"
'sex                   جنس العملة                        "
'FALSE            ( فارغ او صفر مذكر  )                  "
'TRUE          (  أو اي رقم غير الصفر مؤنث )              "
'========================================================"
'sNameCurr       اسم العملة الرئيسية مفرد                "
'pNameCurr         اسم العملة الرئيسية جمع                "
'NameCurrDec           اسم العملة الكسرية                "
'Decimal_Count  طول الكسر افتراضـياً : بدون اظهار الكسر    "
'==============================================================================================================================================="
'xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx"
'==============================================================================================================================================="
'                       ملاحظات
'  (اولاً : العملة الرئيسية  مثنى (يقوم بها الكود تلقائيا
'     مع ملاحظة اذا اسم العملة ينتهي بالتاء المربوطة
'              يجب ان يكتب كذلك وليس بالهاء
'                -----------------------
'      ثانياً : اذا كانت العملة الرئيسية مفرد فارغاً تعتبر
'         اسماء العملات (الجمع والكسري) فارغة تلقائيا
'                -----------------------
'ثالثاً : الكلمة الابتدائية بامكانك تغييرها او تجعلها فارغة
Private Const MyBegTx As String = "فقط "  ' ""
'                -----------------------
' MyTNum  رابعا : يمكنك التغيير (اضافة,حذف,تحرير) في الثابت
'             للفئات الصفرية للرقم ادناه
Private Const MyTNum As String = "ألف-آلاف/مليون-ملايين/مليار-مليارات/بليون-بلايين/بليار-بليارات/ترليون-ترليونات/تريليار-تريليارات/كدرليون-كدرليونات"
'==============================================================================================================================================="
'xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx"
'==============================================================================================================================================="


Function kh_TextNum(Num As String, Optional sex As Boolean = False, Optional sNameCurr As String = "", Optional pNameCurr As String = "", Optional NameCurrDec As String = "", Optional Decimal_Count As Byte = 2) As String
Dim Spp, zt
Dim i%, ii%, pr%
Dim MyMid$, nCurr$, Txt$, Txt1$, Txt2$
'======================================
If Not IsNumeric(Num) Then GoTo kh_Exit
Spp = Split("/" & MyTNum, "/")
ii = UBound(Spp)
If Num < 0 Then Num = Abs(Num)
'======================================
If Val(Num) > Val(String((ii + 1) * 3, "9") & ".999") Then GoTo kh_Exit
'======================================
nCurr = sNameCurr & "-" & IIf(pNameCurr = "", sNameCurr, IIf(sNameCurr = "", "", pNameCurr))
'======================================
Txt1 = Format(Num, String((ii + 1) * 3, "0") & ".000")
For i = 0 To ii
    MyMid = Mid(Txt1, (i * 3) + 1, 3)
    If MyMid Then
        zt = Mid(Txt1, (i * 3) + 4, Len(Txt1))
        zt = IIf(ii - i, Int(zt), zt)
        Txt2 = IIf(ii - i, Trim(Spp(ii - i)), nCurr)
        pr = 1 + IIf(ii - i, 1, CInt(sex))
        Txt = Txt & IIf(Len(Txt), " و", "") & kh_nText(MyMid, Txt2, pr, zt, CBool(sNameCurr <> ""))
    End If
    If i = ii Then If MyMid = 0 Then Txt = Txt & IIf(Len(Txt), " ", "صفر ") & sNameCurr
Next
'======================================
Txt = MyBegTx & Txt & kh_dText(Num, sNameCurr, NameCurrDec, Decimal_Count)
'======================================
kh_Exit:
kh_TextNum = Trim(Txt)
End Function






'    معالجة العدد من 1 الى 999   لكل فئات الرقم
Private Function kh_nText(ByVal iNum As String, ByVal oMm As String, ByVal ibs As Integer, ByVal z As Boolean, ByVal tCu As Boolean) As String
Dim Sp
Dim Num1%, Num2%, Num3%
Dim oM$, S$, S1$, nT$, nT0$, nT1$, nT2$
'======================================
Sp = Split("واحد,إحدى,اثنتان,ثلاث,أربع,خمس,ست,سبع,ثمان,تسع,عشر,إحدى ,اثنتا ", ",")
'======================================
If ibs Then S = "ة": Sp(1) = Sp(0): Sp(2) = "اثنان": Sp(11) = "أحد ": Sp(12) = "اثنا " Else S1 = "ة"
oM = Trim(Split(oMm, "-")(0))
'======================================
Num1 = Left(iNum, 1)
Num2 = Right(iNum, 2)
Select Case Num1
    Case 1:      nT0 = "مائة"
    Case 2:      nT0 = "مائتا" & IIf(ibs = 2, IIf(Num2 < 3, "", "ن"), IIf(Num2 = 0 And oM <> "", "", "ن"))
    Case 3 To 9: nT0 = Sp(Num1) & "مائة"
End Select
'=========================================
Num1 = Right(iNum, 2)
Select Case Num1
    Case 1, 2:     If nT0 <> "" Then If ibs = 2 Then nT0 = nT0 & " " & oM
    Case 11 To 99: If oM <> "" Then If ibs Then If z Then oM = oM & "اً"
End Select
'-----------------------------------------
Select Case Num1
    Case 1
        nT = IIf(oM = "", Sp(0) & S1, oM)
        oM = IIf(ibs <> 2 And oM <> "", Sp(0) & S1, "")
    Case 2
        nT = IIf(oM = "", Sp(Num1), Replace(oM, "ة", "ت") & IIf(z = 0 And ibs = 2 And tCu, "ا", "ان"))
        oM = IIf(ibs <> 2 And oM <> "", Sp(Num1), "")
    Case 3 To 10
        oM = Trim(Split(oMm, "-")(1))
        nT = Sp(Num1) & S
    Case 11, 12
        nT = Sp(Num1) & Sp(10) & S1
    Case 13 To 19
        nT = Sp(Num1 - 10) & S & " " & Sp(10) & S1
    Case 20 To 99
        Num2 = Right(Num1, 1)
        Num3 = Left(Num1, 1)
        If Num3 = 2 Then nT1 = "عشرون" Else nT1 = Sp(Num3) & "ون"
        nT2 = Sp(Num2) & IIf(Num2 > 2, S, "") & " و" & nT1
        If Num2 = 0 Then nT2 = nT1
        nT = nT2
End Select
'======================================
S = IIf(nT = "" Or iNum < 100, "", " و")
nT = Replace(nT, Sp(8) & "ة", Sp(8) & "ية")
kh_nText = Trim(nT0 & S & nT & " " & oM)
'======================================
End Function




'            معالجة الكسر
Private Function kh_dText(ByVal dNum As String, ByVal NCur As String, ByVal Ndec As String, ByVal co As Byte) As String
Dim Td$, Td1$
On Error GoTo 1
If NCur = "" Then Ndec = ""
Td = Format(Round(CCur(dNum - Int(dNum)), co), "0." & String(co, "0"))
If Td = 0 Or Td = 1 Then Td1 = "": GoTo 1
If Len(Ndec) Then Ndec = " " & Ndec: Td1 = Td * CVar("1" & String(co, "0")) Else Ndec = " " & NCur: Td1 = Td
Td1 = "  و " & Chr(40) & Td1 & Chr(41) & Ndec
1: kh_dText = Td1
End Function




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



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

 

الملفات المرفقة
نوع الملف: rar دالة تحويل الرقم الى نص عربي.rar‏ (30.0 كيلوبايت, المشاهدات 0)

التوقيع
ســبحان الله وبحــمده سبحان الله العــظيم
" يا حي يا قيوم ، برحمتك أستغيث ، أصلح لي شأني كله ، ولا تكلني إلى نفسي طرفة عين "
رد مع اقتباس
قديم 04-28-2021, 11:07 PM   #2
admin
✯ ادارة المنتدى ✯
 
الصورة الرمزية admin
 
تاريخ التسجيل: Mar 2021
الدولة: مصر
المشاركات: 722
معدل تقييم المستوى: 10
admin is a splendid one to beholdadmin is a splendid one to beholdadmin is a splendid one to beholdadmin is a splendid one to beholdadmin is a splendid one to beholdadmin is a splendid one to behold


افتراضي

اضافة مهمة للمشاريع والاعمال الحسابية
تقبل مروري
وواصل تميزك
admin متواجد حالياً
 
رد مع اقتباس
إضافة رد

مواقع النشر (المفضلة)

أدوات الموضوع
انواع عرض الموضوع

تعليمات المشاركة
لا تستطيع إضافة مواضيع جديدة
لا تستطيع الرد على المواضيع
لا تستطيع إرفاق ملفات
لا تستطيع تعديل مشاركاتك

BB code is متاحة
كود [IMG] متاحة
كود HTML معطلة

الانتقال السريع

المواضيع المتشابهه
الموضوع كاتب الموضوع المنتدى مشاركات آخر مشاركة
[تصميم Excel] وضع وصف وإختصار للماكرو وطريقة استدعائه في الاكسيل admin برامج Microsoft Office 2 05-01-2021 07:28 PM
[تصميم Excel] برنامج شئون موظفين مصمم على الاكسيل ابن الوليد برامج Microsoft Office 1 04-28-2021 11:12 PM
[تصميم Excel] أدوات الفورم فى الاكسيل ابن الوليد برامج Microsoft Office 1 04-28-2021 11:06 PM
تعريف كارت DTV-DVB Mantis BDA Receiver ويندوز 7 ويندوز 10 admin الاتصـالات وعـلوم الشــبكات 1 04-13-2021 09:05 PM
[تصميم Excel] تصميم برنامج لترحيل البيانات على الاكسيل admin برامج Microsoft Office 2 04-12-2021 08:05 PM

 

موقع ومنتديات مجمع التطوير موقع يختص بالبرمجة والبرامج المساعدة  للتصاميم والأدوات المساعدة ,مع تقديم العون والمساعدة لكل مبرمج من خلال الأقسام المحددة , كما نعرض الأعمال الجاهزة والمفتوحة المصدر. ويهتم أيضا بالتصاميم والجرافيك وبرامجها وعرض التصاميم وملحقات التصاميم والأدوات المساعدة .كما نتمنى التوفيق لنا ولكم مع أجمل تحية مقدمة منا. 

  • الرئــيســية

  • الــمنــتـدى

  • مركز الرفع

  • التسـجـيل

  • قوانين المنتدى

  • التعـلـيمـات

  • الترقيات

check pagerank

 Flag Counter

كلمة الإدارة  منتدى مجمع التطوير غير مسئول عن أي طرح من الأعضاء فتلك الموضوعات تعبر عن رأى صاحبها ومن خلال وضع قوانين وتعليمات المشاركة بالمنتدى نسعى جاهدين لتطبيق تلك التعليمات. والمنتدى أيضا غير مسئول عن أي اتفاق مالي أو تجارى بين الأعضاء وبذلك تعد هذه الصيغة إخلاء مسئولية من جانب إدارة المنتدى وفقنا ووفقكم الله لما فيه الخير
 
الساعة الآن 07:03 PM


Powered by vBulletin® Copyright ©2000 - 2021, Jelsoft Enterprises Ltd.
جميع الحقوق محفوظة لمجمع التطوير