طائع قام بنشر فبراير 17, 2016 مشاركة قام بنشر فبراير 17, 2016 الى السادة خبراء وأساتذة المنتدى المطلوب بالمرفق تحويل الرقم لنص.rar رابط هذا التعليق شارك More sharing options...
سليم حاصبيا قام بنشر فبراير 17, 2016 مشاركة قام بنشر فبراير 17, 2016 شاهد هذا الفيديو 1 رابط هذا التعليق شارك More sharing options...
طائع قام بنشر فبراير 17, 2016 الكاتب مشاركة قام بنشر فبراير 17, 2016 كل الشكر لأستاذى سليم ولكن الذى اريده هو تفقيط مراكز وليس نقود أى الذى يحصل على المركز 1 يجاوره الأول وهكذا الى الرقم 1000 يجاوره الألف رابط هذا التعليق شارك More sharing options...
ياسر خليل أبو البراء قام بنشر فبراير 17, 2016 مشاركة قام بنشر فبراير 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) أرجو أن يفي بالغرض تقبل تحياتي 1 رابط هذا التعليق شارك More sharing options...
طائع قام بنشر فبراير 17, 2016 الكاتب مشاركة قام بنشر فبراير 17, 2016 استاذى ياسر كم تعلمت منك الكثير واقدم وافر احترامى لك واشكرك هل لى أن أكمل الكود الى الرقم 1000 على منوال حضرتك فى الكود وهل سيقبل الكود الى الرقم 1000 ؟ رابط هذا التعليق شارك More sharing options...
ياسر خليل أبو البراء قام بنشر فبراير 17, 2016 مشاركة قام بنشر فبراير 17, 2016 إن شاء الله يقبل الكود .. ولكن انتظر قليلاً لربما يكون لدى أحد الأخوة حل أفضل من هذا الحل .. لأن الموضوع سيكون مرهق بهذا الشكل .. تقبل تحياتي رابط هذا التعليق شارك More sharing options...
أبوبسمله قام بنشر فبراير 17, 2016 مشاركة قام بنشر فبراير 17, 2016 جزاك الله خيرا اخى ياسر رابط هذا التعليق شارك More sharing options...
ياسر خليل أبو البراء قام بنشر فبراير 17, 2016 مشاركة قام بنشر فبراير 17, 2016 وجزيت خيراً بمثل ما دعوت أخي الحبيب أبو بسملة رابط هذا التعليق شارك More sharing options...
سليم حاصبيا قام بنشر فبراير 17, 2016 مشاركة قام بنشر فبراير 17, 2016 (معدل) للاسف لم استطع ان اجغلها بالعربية ممكن احد الاخوة يحاول فعل ذلك Ordinal_Number.rar تم تعديل فبراير 17, 2016 بواسطه سليم حاصبيا رابط هذا التعليق شارك More sharing options...
ياسر خليل أبو البراء قام بنشر فبراير 17, 2016 مشاركة قام بنشر فبراير 17, 2016 بارك الله فيك أخي الحبيب سليم ولكن أعتقد أن الطلب مختلف عن الملف المرفق تماماً .. المطلوب كالتفقيط ولكن ليس كتفقيط العملات إنما الأرقام بهذا الشكل : الأول - الثاني - الثالث وهكذا أي بترتيب المراكز تقبل تحياتي رابط هذا التعليق شارك More sharing options...
أبوبسمله قام بنشر فبراير 17, 2016 مشاركة قام بنشر فبراير 17, 2016 اخى ياسر الا يمكن جعلها ضمن سلسله نصيه كما اعلم انها من موجوده بالاكسيل وتتم من خلال السلسله مجرده فكره وانتم اعلم منا بهذا العلم جزاكم الله خيرا رابط هذا التعليق شارك More sharing options...
ياسر خليل أبو البراء قام بنشر فبراير 17, 2016 مشاركة قام بنشر فبراير 17, 2016 أخي الكريم أحمد لو جعلناها سلسلة ..وجب أن تكون الأرقام بالترتيب 1 - 2 - 3 لتظهر السلسلة بالترتيب ، وعلى حسب ما فهمت أنه يمكنك كتابة أي رقم لمعرفة الترتيب الخاص به فمثلاً لو بدأنا برقم 10 سيكون الترتيب العاشر والرقم الذي يليه 5 إذاً الترتيب الخامس جزيت خيراً على مساهماتك القيمة والتي تثري الموضوعات بشكل كبير تقبل تحياتي 1 رابط هذا التعليق شارك More sharing options...
سليم حاصبيا قام بنشر فبراير 17, 2016 مشاركة قام بنشر فبراير 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 1 رابط هذا التعليق شارك More sharing options...
أبوبسمله قام بنشر فبراير 17, 2016 مشاركة قام بنشر فبراير 17, 2016 جزاك الله خيرا اخى ياسر على التوضيح انتم من تجعلون المواضيع لها من الروائح الذكيه ما تجذب النفوس فهنيئا لكم بما فضلكم الله وزادكم الله من فضله وعلمه بالتوفيق اخى ياسر 1 رابط هذا التعليق شارك More sharing options...
كريم الفلسطيني قام بنشر فبراير 19, 2016 مشاركة قام بنشر فبراير 19, 2016 هناك كود وجدته في مدونة التميز للشروحات.. و هو يقوم بتحويل الارقام الى نص عربي عن طريق خاصية change this number كود تحويل الرقم الى نص عربي.rar 1 رابط هذا التعليق شارك More sharing options...
أبوبسمله قام بنشر فبراير 20, 2016 مشاركة قام بنشر فبراير 20, 2016 2 ساعات مضت, كريم ارس said: هناك كود وجدته في مدونة التميز للشروحات.. و هو يقوم بتحويل الارقام الى نص عربي عن طريق خاصية change this number كود تحويل الرقم الى نص عربي.rar كيفية فتح هذا الملف الامتداد غريب اى برنامج يفتح هذا الامتداد اخى كريم وجزاك الله كل خير رابط هذا التعليق شارك More sharing options...
ياسر خليل أبو البراء قام بنشر فبراير 20, 2016 مشاركة قام بنشر فبراير 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 4 رابط هذا التعليق شارك More sharing options...
أبوبسمله قام بنشر فبراير 20, 2016 مشاركة قام بنشر فبراير 20, 2016 جزاك الله كل خير يا غالى تسلم ايدك على التنسيق وعلى التسهيل علينا بارك الله لك فى وقتك وعملك وكل ما تحب ياابو البراء 1 رابط هذا التعليق شارك More sharing options...
ياسر خليل أبو البراء قام بنشر فبراير 20, 2016 مشاركة قام بنشر فبراير 20, 2016 وجزيت خيراً بمثل ما دعوت لي وزيادة أخي الغالي أحمد وبارك الله فيك على دعائك الطيب المبارك وعلى متابعتك الممتازة للمنتدى تقبل تحياتي رابط هذا التعليق شارك More sharing options...
أبوعيد قام بنشر فبراير 20, 2016 مشاركة قام بنشر فبراير 20, 2016 السلام عليكم هذه مساعدة بسيطة جدددداااااا هذه الترتيبيات اجتهدت في كتابتها يدويا منذ فترة طويلة اكتفيت بنقلها لكم , بالأمكان نقلها إلى أي خلية باستخدام VLOOKUP تفضلوا تحويل الرقم لنص1.rar رابط هذا التعليق شارك More sharing options...
أبوبسمله قام بنشر فبراير 20, 2016 مشاركة قام بنشر فبراير 20, 2016 جزاك الله كل خير اخى ابوعيد رابط هذا التعليق شارك More sharing options...
محي الدين ابو البشر قام بنشر فبراير 20, 2016 مشاركة قام بنشر فبراير 20, 2016 السلام عليكم ورحمة من لدنه وبركات بعد إذنكم هذه دالة من هذا الصرح العظيم استخدمها منذ زمن ولا أتذكر من الذي ارفقها فعذرا الدالة بالاساس للتفقيط ةلكني في هذا المرفق عدلت عليها للتوافق مع متطلبات الأخ طائع أرجو أن أكون قد وفقت واتمنى ابداء الرأي وجزاكم الله كل خير دالة ترتيب.rar 1 رابط هذا التعليق شارك More sharing options...
أبوبسمله قام بنشر فبراير 20, 2016 مشاركة قام بنشر فبراير 20, 2016 1 ساعه مضت, محي الدين ابو البشر said: السلام عليكم ورحمة من لدنه وبركات بعد إذنكم هذه دالة من هذا الصرح العظيم استخدمها منذ زمن ولا أتذكر من الذي ارفقها فعذرا الدالة بالاساس للتفقيط ةلكني في هذا المرفق عدلت عليها للتوافق مع متطلبات الأخ طائع أرجو أن أكون قد وفقت واتمنى ابداء الرأي وجزاكم الله كل خير دالة ترتيب.rar جزاك الله خيرا ارى والراى لصاحب السؤال انها اوسط الحلول المقدمه لطلبه ان لم يكن هو المطلوب عينه بارك الله فيك اخى محى رابط هذا التعليق شارك More sharing options...
محي الدين ابو البشر قام بنشر فبراير 20, 2016 مشاركة قام بنشر فبراير 20, 2016 بارك الله بك استاذ والحمد لله رب العالمين رابط هذا التعليق شارك More sharing options...
ياسر خليل أبو البراء قام بنشر فبراير 20, 2016 مشاركة قام بنشر فبراير 20, 2016 جزاكم الله خيراً أخي الغالي أبو عيد على الفكرة الجميلة .. بارك الله فيك أخي الكريم محي الدين على الدالة الرائعة أنا شخصياً أرى أن دالة الأخ الفاضل كريم هي الأقوى بعد مشاهدة النتائج الفعلية وهي أقرب الحلول .. عموماً التنوع في الحل يثري الموضوع بشكل كبير جزاكم الله خيراً إخواني وأحبابي في الله 2 رابط هذا التعليق شارك More sharing options...
الردود الموصى بها
Join the conversation
You can post now and register later. If you have an account, sign in now to post with your account.