أطرح سؤالك
1

تفقيط الرقم باللغة العربية

سأل 2019-11-07 23:52:36 +0200

الصورة الرمزية للعضو khsmaam

عاوز دالة تفقيط الرقم بالعربي

edit retag flag offensive close merge delete
0

أجاب 2020-06-10 16:59:44 +0200

الصورة الرمزية للعضو libre officer

updated 2020-06-10 18:55:30 +0200

السلام عليكم،‏

يُرجى أولا نقل هذا البرنامج الذي في الإطار أسفله :‏

Option VBASupport 1
Option Explicit
Option Compatible

'========================================================"
'                       بسم الله الرحمن الرحيم      "
'========================================================"
'               (دالة تحويل الرقم الى نص باللغة العربية (تفقيط  "
'                                   Tafqit          "
'========================================================"
'Num                     الرقم                  "
'========================================================"
'Gender                جنس العملة                       "
'       FALSE   ( أو فارغ او صفر مذكر )                     "
'       TRUE   (  أو اي رقم غير الصفر مؤنث )                    "
'========================================================"
' NCurr_Si      اسم العملة الرئيسة مفرد                 "
' NCurr_Pl        اسم العملة الرئيسة جمع                "
' NCurrDec_Si          اسم العملة الكسرية                   "
'           : للدلالة على تفقيط الجزء العشري عين التالي         "
'NCurrDec_pl       اسم العملة الكسرية جمع                       "

'========================================================"
' Decimal_Count      طول الجزء العشري افتراضـياً : بدون اظهار الجزء العشري  "
'dGender               جنس عملة الجزء العشري                    "
'       FALSE   ( أو فارغ او صفر مذكر )                         "
'       TRUE   (  أو اي رقم غير الصفر مؤنث )                        "
'========================================================"
'البرنامج الأصلي من إنجاز عبدالله باقشير، وقد تم تعديله ليوافق الاستخدام في ليبرأوفيس   "
' كما أضيف له تفقيط العدد السالب
' https://www.officena.net/ib/topic/39447-%D8%AF%D8%A7%D9%84%D8%A9-%D8%AA%D9%81%D9%82%D9%8A%D8%B7-%D8%AA%D8%AD%D9%88%D9%8A%D9%84-%D8%A7%D9%84%D8%B1%D9%82%D9%85-%D8%A7%D9%84%D9%89-%D9%86%D8%B5-%D8%A8%D8%A7%D9%84%D8%B9%D8%B1%D8%A8%D9%8A-%D8%B7%D9%88%D9%84-%D8%A7%D9%84%D8%B1%D9%82%D9%85-%D8%BA%D9%8A%D8%B1-%D9%85%D8%AD%D8%AF%D9%88%D8%AF/
'========================================================"
'xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx"

'                      ملاحظات

'   (اولاً : العملة الرئيسة مثنى (يقوم بها البرنامج تلقائيا
'        مع ملاحظة اذا اسم العملة ينتهي بالتاء المربوطة
'           يجب ان يكتب كذلك وليس بالهاء
'               -----------------------
'     ثانياً : اذا كانت العملة الرئيسة مفرد فارغاً تعتبر
'        اسماء العملات (الجمع والكسري) فارغة تلقائيا

Private Const MyBegTx As String = ""
Private Const MyEndTx As String = ""

'               -----------------------

'MyTNum  رابعا : يمكنك التغيير (اضافة,حذف,تحرير) في الثابت
'                        للفئات الصفرية للرقم ادناه

Private Const MyTNum As String = "ألف-آلاف/مليون-ملايين/مليار-مليارات/بليون-بلايين/بليار-بليارات/ترليون-ترليونات/تريليار-تريليارات/كدرليون-كدرليونات"

'xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx"

'==============================================================="
Private Const wow As String  = " و"
Private Const MyNegTx As String = "سالب "
'==============================================================="

Function Tafqit(Num As String, Optional NCurr_Si As String = "", Optional NCurr_Pl As String = "" _
        , Optional NCurrDec_Si As String = "", Optional NCurrDec_Pl As String = "", Optional Decimal_Count As Byte = 2 _
        , Optional Gender As Boolean = False, Optional dGender As Boolean = False) As String
'======================================

Dim Spp, zt
Dim Neg$ : Neg$ = ""
Dim i%, ii%, pr%
Dim MyMid$, nCurr$, Txt$, Txt1$, Txt2$

'======================================

If Not IsNumeric(Num) Then GoTo kh_Exit
if Num > "99999999999999" Then Txt = "خطأ : تجاوز العدد الحد الأقصى !‏" : GoTo kh_Exit  ' Overflow

If Num = 0 Then Txt = MyBegTx & "صفر " & NCurr_Si: GoTo kh_Exit
'======================================

Spp = Split("/" & MyTNum, "/")

ii = UBound(Spp)

If Num < 0 Then Num = Mid(Num, 2, Len(Num)): Neg$ = MyNegTx

'======================================

If Val(Num) > Val(String((ii + 1) * 3, "9") & ".999") Then Txt = "خطأ : تجاوز العدد الحد الأقصى !‏" : GoTo kh_Exit  ' Overflow

'======================================

nCurr = NCurr_Si & "-" & IIf(NCurr_Pl = "", NCurr_Si, IIf(NCurr_Si = "", "", NCurr_Pl))

'======================================
Dim intPart, dcPart, Txt3, frmtstr, Txtchar
intPart = Split(Num, ".")
dcPart = intPart(UBound(intPart))
Txt3 = intPart(LBound(intPart))
'Txt1 = Format(Txt3, String(Val(ii + 1) * 3, "0") )
frmtstr = String(Val(ii + 1) * 3, "0")

For i = 1 To Len(frmtstr)
    Txtchar = Mid(Txt3, i, 1)
    If Txtchar = "" Then Txt3 = "0 ...
(المزيد)
edit flag offensive delete link المزيد
دخول/تسجيل للإجابة

Question Tools

1 follower

Stats

Asked: 2019-11-07 23:52:36 +0200

Seen: 51 times

Last updated: Jun 10