تفقيط الارقام باللغة العربية Excel و اللغه الانجليزيه

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

تفقيط الارقام باللغة العربية Excel تحويل الرقم الى نص بالعربي نقدم لكم اليوم داله سبق و ان عرضنها و هي داله التفقيط لكن نعرض اليوم تحديثات جديده لهذه الداله و التي تستطيع تفقيط الارقام بما في ذلك الكسور اي الارقام العشريه حتي ثلاث ارقام

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

تفقيط

تفقيط الارقام باللغة العربية Excel هي عمليه تحويل الارقام من الشكل الرقمي المتعارف عليه الي شكل كلمات بالشكل النصي

داله التفقيط

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

دالة تفقيط عربية تصلح لكل العملات

مميزات هذه الداله

التفقيط باللغه العربيه بشكل مميز مع مراعه قواعد اللغه العربيه ( دالة تفقيط عربية تصلح لكل العملات )

يمكن تعديل الداله لتباسب اي عمله محليه ريال سعودي  , دينار كويتي , جنيه مصري دولار اي عمله محليه او اجنبيه اخري

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

يمكن استخدام الكود في الاكسيل او الاكسيس او بعض لغات البرمجه الاخري المعتمده علي vb

 

لتحميل ملف دالة تفقيط الارقام باللغة العربية Excel هنا

 

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

'www.acc-arab.com 
Function lireCentaine (ByVal Montant As Double) مثل String 
Dim ChiffreLettre 
Dim Centaine مثل Double 
Dim Dizaine As Double 
Dim T مثل String 
Dim Chaine As String 
ChiffreLettre = Array ("à"، "nán"، "ËÉ "،" سرّة "،" سمعة "،" É "،" É "،" أمانية "،" É "،" سيرة "،" "،" "،" "، "صرة"، "É Ñ"، "É Ñ"، "Ñ"، "É Ñ") 
Centaine = Int (Montant / 100) 
حدد Case Centaine 
Case 0 
    Chaine = "" 
Case 1 
        Chaine = "لعبة " 
Box 2 
        String =" ماسان " 
Box 3 
        String =" لقاءات " 
Box 4 
        String =" برنامج " 
Box 5 
        String = "مجموعة" 
Case 6 
        String = "سمة" 
Case 7 
        String = "سامة" 
Case 8 
        String = "شركة" 
Case 9 
        String = "سماعة" 
End Select Tens 
= Modulo (Amount، 100) 
حدد حالة عشرات 
    الحالة 0 
        T = "" 
    الحالة من 1 إلى 19 
        T = حرف رقمي (عشرات - 1) 
    الحالة 20 
        T = "صورة" من 
    21 إلى 29 
        T = حرف رقمي (عشرات - 21) و "ورون" 
    الحالة 30 
        T = "لاكون"
    Box 31 To 39 
        T = NumberLetter (Ten - 31) & "ولاتون"
    الحالة 40
    الحالة 90 إلى 99 
        T = "سروون" 
    الحالة من 41 إلى 49
        T = ChiffreLettre (Dizaine - 41) & "وخزون" 
    Case 50 
        T = "صمون" 
    حالة 51 إلى 59 
        T = ChiffreLettre (Dizaine - 51) و "وحموان" 
    الحالة 60 
        T = "أون" الحالة من 
    61 إلى 69 
        T = ChiffreLettre ( Dizaine - 61) & "وحن" 
    Case 70 
        T = "هون" 
    حالة 71 إلى 79 
        T = ChiffreLettre (Dizaine - 71) و "أوون" 
    Case 80 
        T = "شمسان" حالة من 
    81 إلى 89 
        T = ChiffreLettre (Dizaine - 81) & "وسمنون" 
    Case 90 
        T = "أون"
        T = ChiffreLettre (Dizaine - 91) و "أوان" 
    حالة أخرى 
        T = "خطأ التحويل!" 
حدد End 
If Chaine <> "" ثم 
   إذا (T <> "") ثم 
   السلسلة = السلسلة 
   T = "æ" & T 
   End 
   If 
   If Chaine = "" ثم 
   إذا (T <> "") ثم 
   السلسلة = السلسلة 
   T = T 
   End If 
   End 
If (Chaine & "" & T) = "" ثم 
    lireCentaine = "" 
Else 
    lireCentaine = LTrim (Chaine & "") & T 
End If 
End Function 
Function Modulo (ByVal Nombre As Double،
    Round = RoundValue + (5 * 10 ^ - (NumberDeci + 1)) 
    Round = Int (Round * 10 ^ CountDeci) / 10 ^ CountDeci 
End Function 
NumberToArabic (ByVal Total As Double) كملايين 
    خافتة 
    خافتة مثل آلاف مزدوجة خافتة مضاعفة 
    خافت سنت 
    ككسور عشرية مزدوجة 
    باهتة مثل خافت مزدوج T0 مثل 
    خافت السلسلة T1 كسلسلة 
    خافتة T2 كسلسلة 
    خافتة T3 كنتيجة باهتة للسلسلة مثل 
    خافت السلسلة 
    كإجمالي السلسلة 
    = دائري (إجمالي ، 3) 
    ملايين = Int (Modulo (إجمالي / 1000000)، 1000)) 
    الآلاف = Int (Modulo (Int (Total / 1000)، 1000)) 
    مائة = Int (Modulo (Total ، 1000))
    عشرية = Arrondir ((Modulo (Total * 1000، 1000))، 1) 
    
    T0 = lireCentaine (الملايين) 
    T1 = lireCentaine (Milliers) 
    T2 = lireCentaine (cent) 
    T3 = lireCentaine (decimales) 
   If T0 <> "" ثم 
   إذا ( T1 <> "") ثم 
   If (T2 <> "") ثم 
   T0 = T0 
   T1 = "æ" & T1 
   T2 = "æ" & T2 
   End If 
   End 
   If 
   If T0 = "" ثم 
   إذا (T1 <> "") ثم 
   إذا (T2 <> "") ثم 
   T0 = T0 
   T1 = T1 
   T2 = "æ" &T2 
   End If 
   End If 
   End If 
   If T0 <> "" ثم 
   If (T1 <> "") ثم 
   If (T2 = "") ثم
   T0 = ​​T0  
   T1 = "æ" & T1 
   T2 = T2 
   End If
   End If 
   End If 
   If T0 = "" ثم 
   If (T1 <"") ثم 
   If (T2 = "") ثم 
   T0 = T0 
   T1 = T1 
   T2 = T2 
   End If 
   End 
   If 
   If T0 <> " "ثم 
   If (T2 <>" ") ثم 
   If (T1 =" ") ثم 
   T0 = T0 
   T2 =" æ "& T2 
   T1 = T1 
   End If 
   End 
   If 
   If T0 =" "ثم 
   إذا (T2 <>" ") ثم 
   إذا (T1 =" ") ثم 
   T0 = T0 
   T1 = T1 
   T2 = T2 
   End If 
   End 
   If 
   If T0 = "æA" ثم 
            T0 = "" Resultat = 
            Resultat & T0 & "مليون" 
       End 
       If T0 = "شانان" ثم 
          T0 = "" Resultat = Resultat 
        & T0 & "لليوانان" 
       End 
       If Millions> = 3 And Millions <= 10 ثم 
      Resultat = Resultat & T0 & "مالعين" 
       End If 
      Millions> = 11 والملايين <= 999 ثم 
       Resultat = Resultat & T0 & "العيون" 
    Else Resultat 
        = Resultat & "" 
    End 
        If T1 = "واش" ثم 
            T1 = ""
            Resultat = Resultat & T1 & "على" 
        End 
        If T1 = "شانان" ثم 
            T1 = "" 
            Resultat = Resultat & T1 & "أطفال"
        إنهاء إذا 
        كان Milliers> = 3 و Milliers <= 10 ثم Resultat = Resultat 
        & T1 & "la" 
        End If 
        Milliers> = 11 و Milliers <= 999 ثم Resultat = Resultat 
        & T1 & "á" 
    Else Resultat 
        = Resultat & " " 
    End If 
    T2 <>" "ثم 
        Resultat = Resultat & T2 &" فينار كويتي " 
    Else 
        If Resultat <>" "ثم 
            Resultat = Resultat &" سينار كويتي " 
        End If 
    End 
    If T3 <>" "ثم 
        If Resultat < > " 
            Resultat = T3 &" هللا " 
        End If 
            Resultat = Resultat & "æ" & T3 & "صلاح"
    نهاية أخرى إذا كان 
        NombreToArabe 
    = 
وظيفة نهاية النتيجة

 

للداله التفقيط باللغه الانجليزيه و تقبل الارقام العشريه

= SpellNumber(22.50)

Option Explicit

'Main Function

Function SpellNumber(ByVal MyNumber)

Dim Dollars, Cents, Temp
Dim DecimalPlace, Count
ReDim Place(9) As String
Place(2) = " Thousand "
Place(3) = " Million "
Place(4) = " Billion "
Place(5) = " Trillion "
' String representation of amount.
MyNumber = Trim(Str(MyNumber))
' Position of decimal place 0 if none.
DecimalPlace = InStr(MyNumber, ".")
' Convert cents and set MyNumber to dollar amount.

If DecimalPlace > 0 Then

Cents = GetTens(Left(Mid(MyNumber, DecimalPlace + 1) & _ "00", 2))

MyNumber = Trim(Left(MyNumber, DecimalPlace - 1))

End If

Count = 1

Do While MyNumber <> ""

Temp = GetHundreds(Right(MyNumber, 3))

If Temp <> "" Then Dollars = Temp & Place(Count) & Dollars

If Len(MyNumber) > 3 Then

MyNumber = Left(MyNumber, Len(MyNumber) - 3)

Else

MyNumber = ""

End If

Count = Count + 1

Loop

Select Case Dollars

Case ""

Dollars = "No Dollars"

Case "One"

Dollars = "One Dollar"

Case Else

Dollars = Dollars & " Dollars"

End Select

Select Case Cents

Case ""

Cents = " and No Cents"

Case "One"

Cents = " and One Cent"

Case Else

Cents = " and " & Cents & " Cents"

End Select

SpellNumber = Dollars & Cents

End Function


' Converts a number from 100-999 into text

Function GetHundreds(ByVal MyNumber)

Dim Result As String

If Val(MyNumber) = 0 Then Exit Function

MyNumber = Right("000" & MyNumber, 3)

' Convert the hundreds place.

If Mid(MyNumber, 1, 1) <> "0" Then

Result = GetDigit(Mid(MyNumber, 1, 1)) & " Hundred "

End If

' Convert the tens and ones place.

If Mid(MyNumber, 2, 1) <> "0" Then

Result = Result & GetTens(Mid(MyNumber, 2))

Else

Result = Result & GetDigit(Mid(MyNumber, 3))

End If

GetHundreds = Result

End Function


' Converts a number from 10 to 99 into text.


Function GetTens(TensText)

Dim Result As String

Result = "" ' Null out the temporary function value.

If Val(Left(TensText, 1)) = 1 Then ' If value between 10-19...

Select Case Val(TensText)

Case 10: Result = "Ten"

Case 11: Result = "Eleven"

Case 12: Result = "Twelve"

Case 13: Result = "Thirteen"

Case 14: Result = "Fourteen"

Case 15: Result = "Fifteen"

Case 16: Result = "Sixteen"

Case 17: Result = "Seventeen"

Case 18: Result = "Eighteen"

Case 19: Result = "Nineteen"

Case Else

End Select

Else ' If value between 20-99...

Select Case Val(Left(TensText, 1))

Case 2: Result = "Twenty "

Case 3: Result = "Thirty "

Case 4: Result = "Forty "

Case 5: Result = "Fifty "

Case 6: Result = "Sixty "

Case 7: Result = "Seventy "

Case 8: Result = "Eighty "

Case 9: Result = "Ninety "

Case Else

End Select

Result = Result & GetDigit _

(Right(TensText, 1)) ' Retrieve ones place.

End If

GetTens = Result

End Function


' Converts a number from 1 to 9 into text.
Function GetDigit(Digit)
Select Case Val(Digit)
Case 1: GetDigit = "One"
Case 2: GetDigit = "Two"
Case 3: GetDigit = "Three"
Case 4: GetDigit = "Four"
Case 5: GetDigit = "Five"
Case 6: GetDigit = "Six"
Case 7: GetDigit = "Seven"
Case 8: GetDigit = "Eight"
Case 9: GetDigit = "Nine"
Case Else: GetDigit = ""

End Select

End Function

 

يمكنك أيضا مشاهده

الدوال المبرمجه في الاكسيل و كيف يمكن اضافتها في الاكسيل

المرجع الشامل لدوال الاكسيل تحميل مباشر من هنا

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

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

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

لمزيد من التفاصيل قم بزياره هذا الرابط https://acc-arab.com/2022/07/tafqit.html