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

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

ساليوت

بواسطه ساليوت
في منتدى الاكسيل Excel

 مشاركة

الردود الموصى بها

ساليوت

ساليوت

قام بنشر
قام بنشر

الى القائمين على هذا المنتدى المحترمين

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

فقط تحويل الرقم النص مثال

1      واحد        او      one

 

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

رابط هذا التعليق
شارك
أحمد الصواف

أحمد الصواف

قام بنشر
قام بنشر

أخي الكريم عليك اولا باستيراد الملف المرفق عن طريق الخطوات الأتيه

1 - أضغط    alt+f11   

2 - من قائمة insert أختار module

3 - من القائمة على اليسار قف على فولدر module ثم كليك يمين وختار import واختار الملف المرفق الذي قمت بتحميله

4 - أغلق النافذة

5-قم بكتابة المعادلة في الخلية المطلوبه وهي

tafket(الخليه التي تحتوي على الرقم ; "جنية"; " قرش")=

رابط هذا التعليق
شارك
قنديل الصياد

قنديل الصياد

قام بنشر
قام بنشر (معدل)

اخى العزيز

انظر المرفق (تفقيط باللغة العربية )

 

 

Book1.rar

تم تعديل بواسطه قنديل الصياد
  • Like 1
رابط هذا التعليق
شارك
قنديل الصياد

قنديل الصياد

قام بنشر
قام بنشر

ضع هذا الكود فى موديل 

Option Explicit

Global NUM As Variant
Global HALLH As Variant
Global subnum As Variant
Global wrd As Variant

Function NO_TO_WORD(Amount As Variant)
 
If IsNull(Amount) Then Exit Function
 
HALLH = ""

If InStr(Amount, ".") = 0 Then

    NUM = Amount
Else
    NUM = Left(Amount, InStr(Amount, ".") - 1)
       
    HALLH = Right(Amount, Len(Amount) - InStr(Amount, "."))
       
    If Len(HALLH) = 1 Then HALLH = HALLH + "0"
       
End If

wrd = ""

Call n1000000_999999999(NUM)
       
Call n1000_999999(NUM)
       
Call n100_999(NUM)
       
Call n1_99(NUM)
       
       
If wrd <> "" Then

    NO_TO_WORD = wrd + " "
       
    If HALLH <> "" Then
        
        wrd = ""
        
        Call HALLH_999(HALLH)
       
        If Left(HALLH, 1) = "00" Then
            NO_TO_WORD = NO_TO_WORD + " و" + wrd + " "
        Else
            NO_TO_WORD = NO_TO_WORD + " و" + wrd + " "
        End If
        
    End If
       
End If
      
End Function
    
    




Function n1000_999999(XsX As Variant)

If NUM >= 1000 And NUM <= 999999 Then
    
    If NUM < 2000 Then
       
        wrd = " ألف "
        NUM = NUM - 1000
        If NUM <> 0 Then wrd = wrd + " و"
          
    ElseIf NUM >= 2000 And NUM <= 2999 Then
              
        wrd = "ألفان "
        NUM = NUM - 2000
        If NUM <> 0 Then wrd = wrd + " و"
          
    ElseIf NUM <= 9999 Then
    
        Call g1((Val(Left(NUM, 1))))
        wrd = wrd + " آلاف "
        NUM = NUM - (Val(Left(NUM, 1)) * 1000)
        If NUM <> 0 Then wrd = wrd + " و"
          
    Else
    
        Dim old_num As Double
        
        old_num = NUM
        NUM = Val(Mid(NUM, 1, Len(NUM) - 3))
          
        Call n100_999(NUM)
        Call n1_99(NUM)
        wrd = wrd + " ألفاً "
          
        NUM = old_num
          
        If Val(Right(NUM, 3)) <> 0 Then wrd = wrd + " و"
             
        NUM = Val(Right(NUM, 3))
          
    End If
       
End If
        
End Function

    



Function n100_999(XsX As Variant)

If NUM >= 100 And NUM <= 999 Then
    
    Call g3(Val(Left(LTrim(Str(NUM)), 1)) * 100)
    NUM = NUM - (Val(Left(LTrim(Str(NUM)), 1)) * 100)
    If NUM <> 0 Then wrd = wrd + " و"
       
End If
    
End Function
    




Function n1_99(XsX As Variant)

If NUM >= 20 And NUM <= 99 Then
    
    If Val(Right(Str(NUM), 1)) <> 0 Then
    
        Call g1(Val(Right(Str(NUM), 1)))
        wrd = wrd + " و"
          
    End If
       
    Call g2((Val(Left(LTrim(Str(NUM)), 1)) * 10))
       
ElseIf NUM >= 13 And NUM <= 19 Then

    Call g1(Val(Right(Str(NUM), 1)))
    wrd = wrd + " عشر"
       
ElseIf NUM >= 1 And NUM <= 12 Then
    
    Call g1(NUM)
       
End If
    
End Function
    
    
    
    



Function HALLH_99(XsX As Variant)

        
If HALLH >= 20 And HALLH <= 99 Then

    If Val(Right(Str(HALLH), 1)) <> 0 Then
    
        Call g1(Val(Right(Str(HALLH), 1)))
        wrd = wrd + " و"
          
    End If
       
    Call g2((Val(Left(LTrim(Str(HALLH)), 1)) * 10))
       
ElseIf HALLH >= 13 And HALLH <= 19 Then
    
    Call g1(Val(Right(Str(HALLH), 1)))
    wrd = wrd + " عشر"
       
ElseIf HALLH >= 1 And HALLH <= 12 Then

    Call g1(HALLH)
       
End If
    
End Function
    
    
    
    
Function g1(X As Variant)
    
subnum = X
    
If subnum = 1 Then
    wrd = wrd + "واحد"
ElseIf subnum = 2 Then
    wrd = wrd + "إثنان"
ElseIf subnum = 3 Then
    wrd = wrd + "ثلاثة"
ElseIf subnum = 4 Then
    wrd = wrd + "أربعة"
ElseIf subnum = 5 Then
    wrd = wrd + "خمسة"
ElseIf subnum = 6 Then
    wrd = wrd + "ستة"
ElseIf subnum = 7 Then
    wrd = wrd + "سبعة"
ElseIf subnum = 8 Then
    wrd = wrd + "ثمانية"
ElseIf subnum = 9 Then
    wrd = wrd + "تسعة"
ElseIf subnum = 10 Then
    wrd = wrd + "عشرة"
ElseIf subnum = 11 Then
    wrd = wrd + "أحد عشر"
ElseIf subnum = 12 Then
    wrd = wrd + "إثنا عشر"
End If
    
End Function
    
    
    
    
    
    
Function g2(X As Variant)

subnum = X
    
If subnum = 20 Then
    wrd = wrd + "عشرون"
ElseIf subnum = 30 Then
    wrd = wrd + "ثلاثون"
ElseIf subnum = 40 Then
    wrd = wrd + "أربعون"
ElseIf subnum = 50 Then
    wrd = wrd + "خمسون"
ElseIf subnum = 60 Then
    wrd = wrd + "ستون"
ElseIf subnum = 70 Then
    wrd = wrd + "سبعون"
ElseIf subnum = 80 Then
    wrd = wrd + "ثمانون"
ElseIf subnum = 90 Then
    wrd = wrd + "تسعون"
End If
    
End Function
    
    
    
    
    
    
Function g3(X As Variant)

subnum = X
    
If subnum = 100 Then
    wrd = wrd + "مائة"
ElseIf subnum = 200 Then
    wrd = wrd + "مائتان"
ElseIf subnum = 300 Then
    wrd = wrd + "ثلاثمائة"
ElseIf subnum = 400 Then
    wrd = wrd + "اربعمائة"
ElseIf subnum = 500 Then
    wrd = wrd + "خمسمائة"
ElseIf subnum = 600 Then
    wrd = wrd + "ستمائة"
ElseIf subnum = 700 Then
    wrd = wrd + "سبعمائة"
ElseIf subnum = 800 Then
    wrd = wrd + "ثمانمائة"
ElseIf subnum = 900 Then
    wrd = wrd + "تسعمائة"
End If
    
End Function
    
    




Function HALLH_999(XsX As Variant)


If HALLH >= 100 And HALLH <= 999 Then
    
    Call g3(Val(Left(LTrim(Str(HALLH)), 1)) * 100)
    HALLH = HALLH - (Val(Left(LTrim(Str(HALLH)), 1)) * 100)
    If HALLH <> 0 Then wrd = wrd + " و"
    
    Call HALLH_99(HALLH)
    
ElseIf HALLH >= 20 And HALLH <= 99 Then

    If Val(Right(Str(HALLH), 1)) <> 0 Then
    
        Call g1(Val(Right(Str(HALLH), 1)))
        wrd = wrd + " و"
          
    End If
       
    Call g2((Val(Left(LTrim(Str(HALLH)), 1)) * 10))
       
ElseIf HALLH >= 13 And HALLH <= 19 Then
    
    Call g1(Val(Right(Str(HALLH), 1)))
    wrd = wrd + " عشر"
       
ElseIf HALLH >= 1 And HALLH <= 12 Then

    Call g1(HALLH)

       
End If
    

End Function


Private Function n1000000_999999999(XsX As Variant)

If NUM >= 1000000 And NUM <= 999999999 Then
    
    If NUM < 2000000 Then
       
        wrd = "مليون "
        NUM = NUM - 1000000
        If NUM <> 0 Then wrd = wrd + " و"
          
    ElseIf NUM >= 2000000 And NUM <= 2999999 Then
              
        wrd = "مليونان "
        NUM = NUM - 2000000
        If NUM <> 0 Then wrd = wrd + " و"
          
    ElseIf NUM <= 9999999 Then
    
        Call g1((Val(Left(NUM, 1))))
        wrd = wrd + "ملايين "
        NUM = NUM - (Val(Left(NUM, 1)) * 1000000)
        If NUM <> 0 Then wrd = wrd + " و"
          
    Else
    
        Dim old_num As Double
        
        old_num = NUM
        NUM = Val(Mid(NUM, 1, Len(NUM) - 6))
          
        Call n100_999(NUM)
        Call n1_99(NUM)
        wrd = wrd + " مليون "
          
        NUM = old_num
          
        If Val(Right(NUM, 6)) <> 0 Then wrd = wrd + " و"
             
        NUM = Val(Right(NUM, 6))
          
    End If
       
End If
        


End Function

ثم ضع المعادلة التالية فى اى خلية تريد

=NO_TO_WORD(A12)

 

 

 

 

 

 

 

 

 

 

 

 

 

 

رابط هذا التعليق
شارك
قنديل الصياد

قنديل الصياد

قام بنشر
قام بنشر (معدل)

اخى العزيز

انظر المرفق ( تفقيط باللغة الانجليزية )

 

 

 

Book1.rar

تم تعديل بواسطه قنديل الصياد
رابط هذا التعليق
شارك
قنديل الصياد

قنديل الصياد

قام بنشر
قام بنشر (معدل)

الكود المستخدم فى التفقيط باللغة الانجليزية

Option Explicit

Global NUM As Variant
Global HALLH As Variant
Global subnum As Variant
Global wrd As Variant

Function NO_TO_WORD(Amount As Variant)
 
If IsNull(Amount) Then Exit Function
 
HALLH = ""

If InStr(Amount, ".") = 0 Then

    NUM = Amount
Else
    NUM = Left(Amount, InStr(Amount, ".") - 1)
       
    HALLH = Right(Amount, Len(Amount) - InStr(Amount, "."))
       
    If Len(HALLH) = 1 Then HALLH = HALLH + "0"
       
End If

wrd = ""

Call n1000000_999999999(NUM)
       
Call n1000_999999(NUM)
       
Call n100_999(NUM)
       
Call n1_99(NUM)
       
       
If wrd <> "" Then

    NO_TO_WORD = wrd + " "
       
    If HALLH <> "" Then
        
        wrd = ""
        
        Call HALLH_999(HALLH)
       
        If Left(HALLH, 1) = " Zero Zero " Then
            NO_TO_WORD = NO_TO_WORD + " and" + wrd + " "
        Else
            NO_TO_WORD = NO_TO_WORD + " and" + wrd + " "
        End If
        
    End If
       
End If
      
End Function
    
    




Function n1000_999999(XsX As Variant)

If NUM >= 1000 And NUM <= 999999 Then
    
    If NUM < 2000 Then
       
        wrd = " Thousand"
        NUM = NUM - 1000
        If NUM <> 0 Then wrd = wrd + " and"
          
    ElseIf NUM >= 2000 And NUM <= 2999 Then
              
        wrd = " Two thousand "
        NUM = NUM - 2000
        If NUM <> 0 Then wrd = wrd + " and"
          
    ElseIf NUM <= 9999 Then
    
        Call g1((Val(Left(NUM, 1))))
        wrd = wrd + " Thousands "
        NUM = NUM - (Val(Left(NUM, 1)) * 1000)
        If NUM <> 0 Then wrd = wrd + " and"
          
    Else
    
        Dim old_num As Double
        
        old_num = NUM
        NUM = Val(Mid(NUM, 1, Len(NUM) - 3))
          
        Call n100_999(NUM)
        Call n1_99(NUM)
        wrd = wrd + " Thousand "
          
        NUM = old_num
          
        If Val(Right(NUM, 3)) <> 0 Then wrd = wrd + " and"
             
        NUM = Val(Right(NUM, 3))
          
    End If
       
End If
        
End Function

    



Function n100_999(XsX As Variant)

If NUM >= 100 And NUM <= 999 Then
    
    Call g3(Val(Left(LTrim(Str(NUM)), 1)) * 100)
    NUM = NUM - (Val(Left(LTrim(Str(NUM)), 1)) * 100)
    If NUM <> 0 Then wrd = wrd + " and"
       
End If
    
End Function
    




Function n1_99(XsX As Variant)

If NUM >= 20 And NUM <= 99 Then
    
    If Val(Right(Str(NUM), 1)) <> 0 Then
    
        Call g1(Val(Right(Str(NUM), 1)))
        wrd = wrd + " and"
          
    End If
       
    Call g2((Val(Left(LTrim(Str(NUM)), 1)) * 10))
       
ElseIf NUM >= 13 And NUM <= 19 Then

    Call g1(Val(Right(Str(NUM), 1)))
    wrd = wrd + " Ten "
       
ElseIf NUM >= 1 And NUM <= 12 Then
    
    Call g1(NUM)
       
End If
    
End Function
    
    
    
    



Function HALLH_99(XsX As Variant)

        
If HALLH >= 20 And HALLH <= 99 Then

    If Val(Right(Str(HALLH), 1)) <> 0 Then
    
        Call g1(Val(Right(Str(HALLH), 1)))
        wrd = wrd + " And "
          
    End If
       
    Call g2((Val(Left(LTrim(Str(HALLH)), 1)) * 10))
       
ElseIf HALLH >= 13 And HALLH <= 19 Then
    
    Call g1(Val(Right(Str(HALLH), 1)))
    wrd = wrd + " Ten "
       
ElseIf HALLH >= 1 And HALLH <= 12 Then

    Call g1(HALLH)
       
End If
    
End Function
    
    
    
    
Function g1(X As Variant)
    
subnum = X
    
If subnum = 1 Then
    wrd = wrd + " One "
ElseIf subnum = 2 Then
    wrd = wrd + " Two "
ElseIf subnum = 3 Then
    wrd = wrd + " Three "
ElseIf subnum = 4 Then
    wrd = wrd + " Four "
ElseIf subnum = 5 Then
    wrd = wrd + " Five "
ElseIf subnum = 6 Then
    wrd = wrd + " Six "
ElseIf subnum = 7 Then
    wrd = wrd + " Seven "
ElseIf subnum = 8 Then
    wrd = wrd + " Eight "
ElseIf subnum = 9 Then
    wrd = wrd + " Nine "
ElseIf subnum = 10 Then
    wrd = wrd + " Ten "
ElseIf subnum = 11 Then
    wrd = wrd + " eleven "
ElseIf subnum = 12 Then
    wrd = wrd + " Twelve "
End If
    
End Function
    
    
    
    
    
    
Function g2(X As Variant)

subnum = X
    
If subnum = 20 Then
    wrd = wrd + " Twenty "
ElseIf subnum = 30 Then
    wrd = wrd + " Thirty "
ElseIf subnum = 40 Then
    wrd = wrd + " Forty "
ElseIf subnum = 50 Then
    wrd = wrd + " Fifty "
ElseIf subnum = 60 Then
    wrd = wrd + " Sixty "
ElseIf subnum = 70 Then
    wrd = wrd + " Seventy "
ElseIf subnum = 80 Then
    wrd = wrd + " Eighty "
ElseIf subnum = 90 Then
    wrd = wrd + " Ninety "
End If
    
End Function
    
    
    
    
    
    
Function g3(X As Variant)

subnum = X
    
If subnum = 100 Then
    wrd = wrd + " Hundred "
ElseIf subnum = 200 Then
    wrd = wrd + " Two hundred "
ElseIf subnum = 300 Then
    wrd = wrd + " Three hundred "
ElseIf subnum = 400 Then
    wrd = wrd + " Four hundred "
ElseIf subnum = 500 Then
    wrd = wrd + " Five hundred "
ElseIf subnum = 600 Then
    wrd = wrd + " Six hundred "
ElseIf subnum = 700 Then
    wrd = wrd + " Seven hundred "
ElseIf subnum = 800 Then
    wrd = wrd + " Eight hundred "
ElseIf subnum = 900 Then
    wrd = wrd + " Nine hundred "
End If
    
End Function
    
    




Function HALLH_999(XsX As Variant)


If HALLH >= 100 And HALLH <= 999 Then
    
    Call g3(Val(Left(LTrim(Str(HALLH)), 1)) * 100)
    HALLH = HALLH - (Val(Left(LTrim(Str(HALLH)), 1)) * 100)
    If HALLH <> 0 Then wrd = wrd + " æ"
    
    Call HALLH_99(HALLH)
    
ElseIf HALLH >= 20 And HALLH <= 99 Then

    If Val(Right(Str(HALLH), 1)) <> 0 Then
    
        Call g1(Val(Right(Str(HALLH), 1)))
        wrd = wrd + " And "
          
    End If
       
    Call g2((Val(Left(LTrim(Str(HALLH)), 1)) * 10))
       
ElseIf HALLH >= 13 And HALLH <= 19 Then
    
    Call g1(Val(Right(Str(HALLH), 1)))
    wrd = wrd + " Ten "
       
ElseIf HALLH >= 1 And HALLH <= 12 Then

    Call g1(HALLH)

       
End If
    

End Function


Private Function n1000000_999999999(XsX As Variant)

If NUM >= 1000000 And NUM <= 999999999 Then
    
    If NUM < 2000000 Then
       
        wrd = " Million "
        NUM = NUM - 1000000
        If NUM <> 0 Then wrd = wrd + " and"
          
    ElseIf NUM >= 2000000 And NUM <= 2999999 Then
              
        wrd = " Two million "
        NUM = NUM - 2000000
        If NUM <> 0 Then wrd = wrd + " and"
          
    ElseIf NUM <= 9999999 Then
    
        Call g1((Val(Left(NUM, 1))))
        wrd = wrd + " Millions "
        NUM = NUM - (Val(Left(NUM, 1)) * 1000000)
        If NUM <> 0 Then wrd = wrd + " and"
          
    Else
    
        Dim old_num As Double
        
        old_num = NUM
        NUM = Val(Mid(NUM, 1, Len(NUM) - 6))
          
        Call n100_999(NUM)
        Call n1_99(NUM)
        wrd = wrd + " Million "
          
        NUM = old_num
          
        If Val(Right(NUM, 6)) <> 0 Then wrd = wrd + " and"
             
        NUM = Val(Right(NUM, 6))
          
    End If
       
End If
        


End Function

المعادلة المستخدمة

=NO_TO_WORD(A1)
تم تعديل بواسطه قنديل الصياد
رابط هذا التعليق
شارك
  • 2 weeks later...
wlid

wlid

قام بنشر
قام بنشر

اخى العزيز

انظر المرفق (تفقيط باللغة العربية )

 

بارك الله فيك ومشكور على هذا المجهود .. لكن اخي الكريم لم استطع كتابة كلمة ( فقط ) وكلمة ( دينار ) وكلمة (درهم ) وكلمة (لا غير ) مثل 1358.526= فقط الف وثلاثمائة وثمانية وخمسون دينار و خمسمائة وستة وعشرون درهم لا غير 

attachicon.gifBook1.rar

  • Like 1
رابط هذا التعليق
شارك
wlid

wlid

قام بنشر
قام بنشر

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

837.      9821                                   قنديل الصياد

 

         فقط تسعة آلاف وثمانمائة وواحد وعشرون دينار و درهم لا غير 

رابط هذا التعليق
شارك

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.

زائر
اضف رد علي هذا الموضوع....

×   Pasted as rich text.   Paste as plain text instead

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

×
 مشاركة
الذهاب الي قائمه المواضيع

  • تصفح هذا الموضوع مؤخراً   0 اعضاء متواجدين الان

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

Important Information

  I accept