تحويل الرقم لنص عربى

**طائع** · فبراير 17, 2016

الى السادة خبراء وأساتذة المنتدى

المطلوب بالمرفق

تحويل الرقم لنص.rar

**سليم حاصبيا** · فبراير 17, 2016

شاهد هذا الفيديو

**طائع** · فبراير 17, 2016

كل الشكر لأستاذى سليم ولكن الذى اريده هو تفقيط مراكز وليس نقود

أى الذى يحصل على المركز 1 يجاوره الأول وهكذا الى الرقم 1000 يجاوره الألف

ياسر خليل أبو البراء · فبراير 17, 2016

أخي الكريم طائع

يمكنك استخدام دالة معرفة بهذا الشكل البسيط ..لقد قمت بإضافة من 1 إلى 30 (لعله يكون هناك طرق أفضل لتنفيذ المطلوب)

Function SpellNumber(MyNumber)
    Select Case Val(MyNumber)
        Case 1: MyNumber = "الأول"
        Case 2: MyNumber = "الثاني"
        Case 3: MyNumber = "الثالث"
        Case 4: MyNumber = "الرابع"
        Case 5: MyNumber = "الخامس"
        Case 6: MyNumber = "السادس"
        Case 7: MyNumber = "السابع"
        Case 8: MyNumber = "الثامن"
        Case 9: MyNumber = "التاسع"
        Case 10: MyNumber = "العاشر"
        Case 11: MyNumber = "الحادي عشر"
        Case 12: MyNumber = "الثاني عشر"
        Case 13: MyNumber = "الثالث عشر"
        Case 14: MyNumber = "الرابع عشر"
        Case 15: MyNumber = "الخامس عشر"
        Case 16: MyNumber = "السادس عشر"
        Case 17: MyNumber = "السابع عشر"
        Case 18: MyNumber = "الثامن عشر"
        Case 19: MyNumber = "التاسع عشر"
        Case 20: MyNumber = "العشرون"
        Case 21: MyNumber = "الحادي والعشرون"
        Case 22: MyNumber = "الثاني والعشرون"
        Case 23: MyNumber = "الثالث والعشرون"
        Case 24: MyNumber = "الرابع والعشرون"
        Case 25: MyNumber = "الخامس والعشرون"
        Case 26: MyNumber = "السادس والعشرون"
        Case 27: MyNumber = "السابع والعشرون"
        Case 28: MyNumber = "الثامن والعشرون"
        Case 29: MyNumber = "التاسع والعشرون"
        Case 30: MyNumber = "الثلاثون"
        Case Else: MyNumber = ""
    End Select
    
    SpellNumber = MyNumber
End Function

يمكنك استخدام الدالة المعرفة بهذا الشكل

=SpellNumber(A1)

أرجو أن يفي بالغرض

تقبل تحياتي

**طائع** · فبراير 17, 2016

استاذى ياسر

كم تعلمت منك الكثير واقدم وافر احترامى لك واشكرك

هل لى أن أكمل الكود الى الرقم 1000 على منوال حضرتك فى الكود وهل سيقبل الكود الى الرقم 1000 ؟

ياسر خليل أبو البراء · فبراير 17, 2016

إن شاء الله يقبل الكود .. ولكن انتظر قليلاً لربما يكون لدى أحد الأخوة حل أفضل من هذا الحل .. لأن الموضوع سيكون مرهق بهذا الشكل ..

تقبل تحياتي

**أبوبسمله** · فبراير 17, 2016

جزاك الله خيرا اخى ياسر

ياسر خليل أبو البراء · فبراير 17, 2016

وجزيت خيراً بمثل ما دعوت أخي الحبيب أبو بسملة

**سليم حاصبيا** · فبراير 17, 2016

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

ممكن احد الاخوة يحاول فعل ذلك

Ordinal_Number.rar

تم تعديل فبراير 17, 2016 بواسطه سليم حاصبيا

ياسر خليل أبو البراء · فبراير 17, 2016

بارك الله فيك أخي الحبيب سليم

ولكن أعتقد أن الطلب مختلف عن الملف المرفق تماماً ..

المطلوب كالتفقيط ولكن ليس كتفقيط العملات إنما الأرقام بهذا الشكل : الأول - الثاني - الثالث وهكذا

أي بترتيب المراكز

تقبل تحياتي

**أبوبسمله** · فبراير 17, 2016

اخى ياسر

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

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

ياسر خليل أبو البراء · فبراير 17, 2016

أخي الكريم أحمد

لو جعلناها سلسلة ..وجب أن تكون الأرقام بالترتيب 1 - 2 - 3 لتظهر السلسلة بالترتيب ، وعلى حسب ما فهمت أنه يمكنك كتابة أي رقم لمعرفة الترتيب الخاص به فمثلاً لو بدأنا برقم 10 سيكون الترتيب العاشر والرقم الذي يليه 5 إذاً الترتيب الخامس

جزيت خيراً على مساهماتك القيمة والتي تثري الموضوعات بشكل كبير

تقبل تحياتي

**سليم حاصبيا** · فبراير 17, 2016

يمكن استعمال هذا الكود و الكتابة في العامود H

(الترتيب برده الاجنبية)

Private Sub Worksheet_Change(ByVal Target As Range)
  
  Application.EnableEvents = False
    
    If IsNumeric(Target.Value) And Target.Count = 1 And Target.Column = 8 Then
    
     Target.Offset(0, 1).Value = Target.Value
      Target.Offset(0, 1).NumberFormat = "#""" & Mid$("thstndrdthththththth", 1 - 2 * ((Target.Value) _
        Mod 10) * (Abs((Target.Value) Mod 100 - 12) > 1), 2) & """"
    End If

  Application.EnableEvents = True
End Sub

**أبوبسمله** · فبراير 17, 2016

جزاك الله خيرا اخى ياسر على التوضيح

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

بالتوفيق اخى ياسر

كريم الفلسطيني · فبراير 19, 2016

هناك كود

وجدته في مدونة التميز للشروحات..

و هو يقوم بتحويل الارقام الى نص عربي

عن طريق خاصية

change this number

كود تحويل الرقم الى نص عربي.rar

**أبوبسمله** · فبراير 20, 2016

2 ساعات مضت, كريم ارس said:

هناك كود

وجدته في مدونة التميز للشروحات..

و هو يقوم بتحويل الارقام الى نص عربي

عن طريق خاصية

change this number

كود تحويل الرقم الى نص عربي.rar

كيفية فتح هذا الملف الامتداد غريب

اى برنامج يفتح هذا الامتداد اخى كريم

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

ياسر خليل أبو البراء · فبراير 20, 2016

الأخ العزيز كريم

بارك الله فيك وجزاك الله كل خير

ملف جميل جداً ومتميز ..

الأخ الحبيب أحمد

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

روح لمحرر الأكواد ..كليك يمين في نافذة المشروع .. اختار الأمر Import File .. حدد مكان الملف الذي أرفقه الأخ كريم بعد فك ضغطه بالطبع والذي امتداده Bas .. وأخيراً انقر الأمر Open ..

ستجد أن الموديول قد أضيف في نافذة المشروع

وإليك الكود الموجود بالملف بعد تنسيقه بشكل مناسب (أحب تنسيق الأكواد ليسهل التعامل معها)

Private Function ChangeToDigits1(Temp As String) As String
    If Temp = "0" Then
        ChangeToDigits1 = ""
        GoTo Finish
    End If
    If Temp = "1" Then
        ChangeToDigits1 = "واحد"
        GoTo Finish
    End If
    If Temp = "2" Then
        ChangeToDigits1 = "اثنان"
        GoTo Finish
    End If
    If Temp = "3" Then
        ChangeToDigits1 = "ثلاثة"
        GoTo Finish
    End If
    If Temp = "4" Then
        ChangeToDigits1 = "أربعة"
        GoTo Finish
    End If
    If Temp = "5" Then
        ChangeToDigits1 = "خمسة"
        GoTo Finish
    End If
    If Temp = "6" Then
        ChangeToDigits1 = "ستة"
        GoTo Finish
    End If
    
    If Temp = "7" Then
        ChangeToDigits1 = "سبعة"
        GoTo Finish
    End If
    
    If Temp = "8" Then
        ChangeToDigits1 = "ثمانية"
        GoTo Finish
    End If
    If Temp = "9" Then
        ChangeToDigits1 = "تسعة"
        GoTo Finish
    End If
Finish:
End Function

Private Function ChangeToDigits2(Temp As String) As String
    Dim Digit1 As String
    Dim Digit2 As String
    Dim Between As String
    
    Digit2 = Left(Temp, 1)
    Digit1 = Right(Temp, 1)
    
    If Digit2 = "1" Then
        ChangeToDigits2 = "عشر"
        GoTo Finish
    End If
    
    If Digit2 = "2" Then
        ChangeToDigits2 = "عشرون"
        GoTo Finish
    End If
    
    If Digit2 = "3" Then
        ChangeToDigits2 = "ثلاثون"
        GoTo Finish
    End If
    If Digit2 = "4" Then
        ChangeToDigits2 = "أربعون"
        GoTo Finish
    End If
    If Digit2 = "5" Then
        ChangeToDigits2 = "خمسون"
        GoTo Finish
    End If
    If Digit2 = "6" Then
        ChangeToDigits2 = "ستون"
        GoTo Finish
    End If
    If Digit2 = "7" Then
        ChangeToDigits2 = "سبعون"
        GoTo Finish
    End If
    If Digit2 = "8" Then
        ChangeToDigits2 = "ثمانون"
        GoTo Finish
    End If
    If Digit2 = "9" Then
        ChangeToDigits2 = "تسعون"
        GoTo Finish
    End If
    
Finish:
    If Digit1 = "0" Then
        Digit1 = ""
        Between = ""
    Else
        If Digit2 = "1" Then
            Between = " "
            Digit1 = ChangeToDigits1(Digit1)
        Else
            Between = " و "
            Digit1 = ChangeToDigits1(Digit1)
        End If
    End If
    
    If Digit2 = "0" Then Between = ""
    
    ChangeToDigits2 = Digit1 & Between & ChangeToDigits2
    If Temp = "00" Then ChangeToDigits2 = ""
    If Temp = "11" Then ChangeToDigits2 = "احدى عشر"
    If Temp = "12" Then ChangeToDigits2 = "اثنا عشر"
    
    If Temp = "10" Then ChangeToDigits2 = "عشرة"
End Function

Private Function ChangeToDigits3(Temp As String) As String
    Dim Between As String
    Dim Handred As String
    Dim First As String
    Dim Second As String
    
    Handred = " مائة"
    First = ChangeToDigits1(Left(Temp, 1))
    Second = ChangeToDigits2(Right(Temp, 2))
    
    If Second <> "" Then Between = " و " Else Between = ""
    
    If First = "" Then
        Between = ""
        Handred = ""
    End If
    
    If First = "واحد" Then First = ""
    
    If First = "اثنان" Then
        First = ""
        Handred = "مئتا"
    End If
    
    ChangeToDigits3 = First & Handred & Between & Second
    If Temp = "000" Then ChangeToDigits3 = ""
End Function

Private Function ChangeToDigits4(Temp As String) As String
    Dim Between As String
    Dim Thousand As String
    Dim First As String
    Dim Second As String
    Thousand = " آلاف"
    First = ChangeToDigits1(Left(Temp, 1))
    Second = ChangeToDigits3(Right(Temp, 3))
    If Second <> "" Then Between = " و " Else Between = ""
    
    If First = "" Then
        Between = ""
        Thousand = ""
    End If
    
    If First = "واحد" Then
        First = ""
        Thousand = "الف"
    End If
    
    If First = "اثنان" Then
        First = ""
        Thousand = "الفا"
    End If
    
    ChangeToDigits4 = First & Thousand & Between & Second
    If Temp = "0000" Then ChangeToDigits4 = ""
End Function

Private Function ChangeToDigits5(Temp As String) As String
    Dim Between As String
    Dim Thousand As String
    Dim First As String
    Dim Second As String
    
    Thousand = " ألف"
    First = ChangeToDigits2(Left(Temp, 2))
    Second = ChangeToDigits3(Right(Temp, 3))
    
    If Second <> "" Then Between = " و " Else Between = ""
    
    If First = "" Then
        Between = ""
        Thousand = ""
    End If
    
    If First = "واحد" Then
        First = ""
        Thousand = "ألف"
    End If
    If First = "اثنان" Then
        First = ""
        Thousand = "ألفا"
    End If
    
    ChangeToDigits5 = First & Thousand & Between & Second
    If Temp = "00000" Then ChangeToDigits5 = ""
End Function

Private Function ChangeToDigits6(Temp As String) As String
    Dim Between As String
    Dim Thousand As String
    Dim First As String
    Dim Second As String
    
    Thousand = " الف"
    First = ChangeToDigits3(Left(Temp, 3))
    Second = ChangeToDigits3(Right(Temp, 3))
    
    If Second <> "" Then Between = " و " Else Between = ""
    
    If First = "" Then
        Between = ""
        Thousand = ""
    End If
    
    If First = "واحد" Then
        First = ""
        Thousand = "ألف"
    End If
    
    If First = "اثنان" Then
        First = ""
        Thousand = "ألفا"
    End If
    
    ChangeToDigits6 = First & Thousand & Between & Second
    If Temp = "000000" Then ChangeToDigits6 = ""
End Function

Private Function ChangeToDigits7(Temp As String) As String
    Dim Between As String
    Dim Million As String
    Dim First As String
    Dim Second As String
    
    Million = "ملايين"
    First = ChangeToDigits1(Left(Temp, 1))
    Second = ChangeToDigits6(Right(Temp, 6))
    
    If Second <> "" Then Between = " و " Else Between = ""
    
    If First = "" Then
        Between = ""
        Million = ""
    End If
    
    If First = "واحد" Then
        First = ""
        Million = "مليون"
    End If
    If First = "اثنان" Then
        First = ""
        Million = "مليونا"
    End If
    
    ChangeToDigits7 = First & Million & Between & Second
End Function

Private Function ChangeToDigits8(Temp As String) As String
    Dim Between As String
    Dim Million As String
    Dim First As String
    Dim Second As String
    
    Million = " مليون "
    First = ChangeToDigits2(Left(Temp, 2))
    Second = ChangeToDigits6(Right(Temp, 6))
    
    If Second <> "" Then Between = " و " Else Between = ""
    
    If First = "" Then
        Between = ""
        Million = ""
    End If
    
    If First = "واحد" Then
        First = ""
        Million = " مليون "
    End If
    If First = "اثنان" Then
        First = ""
        Million = "مليونا"
    End If
    
    ChangeToDigits8 = First & Million & Between & Second
End Function

Private Function ChangeToDigits9(Temp As String) As String
    Dim Between As String
    Dim Million As String
    Dim First As String
    Dim Second As String
    
    Million = " مليون "
    First = ChangeToDigits3(Left(Temp, 3))
    Second = ChangeToDigits6(Right(Temp, 6))
    
    If Second <> "" Then Between = " و " Else Between = ""
    
    If First = "" Then
        Between = ""
        Million = ""
    End If
    
    If First = "واحد" Then
        First = ""
        Million = " مليون "
    End If
    
    If First = "اثنان" Then
        First = ""
        Million = "مليونا"
    End If
    
    ChangeToDigits9 = First & Million & Between & Second
End Function

Public Function ChangeThisNumber(Allnumber As String) As String
    Dim Temp As String
    Dim Backed As String
    Dim Backed2 As String
    Dim Length As Integer
    Dim bigCur, smallCur As String
    Dim intNum As String
    Dim FloatNum As String
    Dim I As Integer
    Dim Found As Boolean
    
    Allnumber = Trim(Allnumber)
    If Not IsNumeric(Allnumber) Then
        ChangeThisNumber = "خطأ في الإدخال"
        Exit Function
    End If
    
    I = 1
    Do While I <> Len(Allnumber) + 1
        If Mid(Allnumber, I, 1) <> "." Then
            intNum = intNum & Mid(Allnumber, I, 1)
        Else
            Found = True
            GoTo Float
        End If
        I = I + 1
    Loop
    
Float:
    If Found Then
        I = I + 1
        Do While I <> Len(Allnumber) + 1
            FloatNum = FloatNum & Mid(Allnumber, I, 1)
            I = I + 1
        Loop
    End If
    
    Temp = intNum
    Length = Len(Temp)
    
    If Length = 1 Then Backed = ChangeToDigits1(Temp)
    If Length = 2 Then Backed = ChangeToDigits2(Temp)
    If Length = 3 Then Backed = ChangeToDigits3(Temp)
    If Length = 4 Then Backed = ChangeToDigits4(Temp)
    If Length = 5 Then Backed = ChangeToDigits5(Temp)
    If Length = 6 Then Backed = ChangeToDigits6(Temp)
    If Length = 7 Then Backed = ChangeToDigits7(Temp)
    If Length = 8 Then Backed = ChangeToDigits8(Temp)
    If Length = 9 Then Backed = ChangeToDigits9(Temp)
    
    Temp = FloatNum
    Length = Len(Temp)
    
    If Length = 1 Then Backed2 = ChangeToDigits1(Temp)
    If Length = 2 Then Backed2 = ChangeToDigits2(Temp)
    If Length = 3 Then Backed2 = ChangeToDigits3(Temp)
    If Length = 4 Then Backed2 = ChangeToDigits4(Temp)
    If Length = 5 Then Backed2 = ChangeToDigits5(Temp)
    If Length = 6 Then Backed2 = ChangeToDigits6(Temp)
    If Length = 7 Then Backed2 = ChangeToDigits7(Temp)
    If Length = 8 Then Backed2 = ChangeToDigits8(Temp)
    If Length = 9 Then Backed2 = ChangeToDigits9(Temp)
    
    smallCur = StrSmallNameCurrency
    bigCur = StrLargeNameCurrency
    
    Dim Filse As String
    Dim Between As String
    Dim JD As String
    
    Between = " و "
    
    If Backed <> "" Then
        JD = " " & bigCur & " "
    Else
        JD = ""
        Between = ""
    End If
    
    If Backed2 <> "" Then
        Filse = " " & smallCur & " "
    Else
        Filse = ""
        Between = ""
    End If
    
    ChangeThisNumber = Backed & JD & Between & Backed2 & Filse
End Function

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

ضع رقم في الخلية A1 وفي الخلية B1 ضع المعادلة التالية

=ChangeThisNumber(A1)

وإليك الملف المرفق مطبق فيه الدالة المعرفة ..

تقبل وافر تقديري واحترامي

Spell Number UDF Function Karim.rar

**أبوبسمله** · فبراير 20, 2016

جزاك الله كل خير يا غالى

تسلم ايدك على التنسيق وعلى التسهيل علينا

بارك الله لك فى وقتك وعملك وكل ما تحب ياابو البراء

ياسر خليل أبو البراء · فبراير 20, 2016

وجزيت خيراً بمثل ما دعوت لي وزيادة أخي الغالي أحمد

وبارك الله فيك على دعائك الطيب المبارك وعلى متابعتك الممتازة للمنتدى

تقبل تحياتي

**أبوعيد** · فبراير 20, 2016

السلام عليكم

هذه مساعدة بسيطة جدددداااااا

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

اكتفيت بنقلها لكم , بالأمكان نقلها إلى أي خلية باستخدام VLOOKUP

تفضلوا

تحويل الرقم لنص1.rar

**أبوبسمله** · فبراير 20, 2016

جزاك الله كل خير اخى ابوعيد

**محي الدين ابو البشر** · فبراير 20, 2016

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

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

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

أرجو أن أكون قد وفقت

واتمنى ابداء الرأي

وجزاكم الله كل خير

دالة ترتيب.rar

**أبوبسمله** · فبراير 20, 2016

1 ساعه مضت, محي الدين ابو البشر said:

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

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

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

أرجو أن أكون قد وفقت

واتمنى ابداء الرأي

وجزاكم الله كل خير

دالة ترتيب.rar

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

ارى والراى لصاحب السؤال انها اوسط الحلول المقدمه لطلبه ان لم يكن هو المطلوب عينه

بارك الله فيك اخى محى

**محي الدين ابو البشر** · فبراير 20, 2016

بارك الله بك استاذ

والحمد لله رب العالمين

ياسر خليل أبو البراء · فبراير 20, 2016

جزاكم الله خيراً أخي الغالي أبو عيد على الفكرة الجميلة ..

بارك الله فيك أخي الكريم محي الدين على الدالة الرائعة

أنا شخصياً أرى أن دالة الأخ الفاضل كريم هي الأقوى بعد مشاهدة النتائج الفعلية وهي أقرب الحلول ..

عموماً التنوع في الحل يثري الموضوع بشكل كبير

جزاكم الله خيراً إخواني وأحبابي في الله

تسجيل الدخول

تحويل الرقم لنص عربى

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

طائع

سليم حاصبيا

طائع

ياسر خليل أبو البراء

طائع

ياسر خليل أبو البراء

أبوبسمله

ياسر خليل أبو البراء

سليم حاصبيا

ياسر خليل أبو البراء

أبوبسمله

ياسر خليل أبو البراء

سليم حاصبيا

أبوبسمله

كريم الفلسطيني

أبوبسمله

ياسر خليل أبو البراء

أبوبسمله

ياسر خليل أبو البراء

أبوعيد

أبوبسمله

محي الدين ابو البشر

أبوبسمله

محي الدين ابو البشر

ياسر خليل أبو البراء

Join the conversation

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

تصفح الموقع

تصفح جديد الموقع

Support

Important Information