ساليوت قام بنشر ديسمبر 16, 2013 قام بنشر ديسمبر 16, 2013 الى القائمين على هذا المنتدى المحترمين ممكن المساعدة في معرفة وتوضيح كيفية تحويل الارقام الى نص بالعربية او الانجليزية مع عدم ظهور وحدة العملة فقط تحويل الرقم النص مثال 1 واحد او one وشكرا لكم جميعا
أحمد الصواف قام بنشر ديسمبر 16, 2013 قام بنشر ديسمبر 16, 2013 أخي الكريم عليك اولا باستيراد الملف المرفق عن طريق الخطوات الأتيه 1 - أضغط alt+f11 2 - من قائمة insert أختار module 3 - من القائمة على اليسار قف على فولدر module ثم كليك يمين وختار import واختار الملف المرفق الذي قمت بتحميله 4 - أغلق النافذة 5-قم بكتابة المعادلة في الخلية المطلوبه وهي tafket(الخليه التي تحتوي على الرقم ; "جنية"; " قرش")=
أحمد الصواف قام بنشر ديسمبر 16, 2013 قام بنشر ديسمبر 16, 2013 (معدل) عفوا الملف المرفق هنا tafkeet.rar تم تعديل ديسمبر 16, 2013 بواسطه أحمد الصواف 1
قنديل الصياد قام بنشر ديسمبر 16, 2013 قام بنشر ديسمبر 16, 2013 (معدل) اخى العزيز انظر المرفق (تفقيط باللغة العربية ) Book1.rar تم تعديل ديسمبر 16, 2013 بواسطه قنديل الصياد 1
قنديل الصياد قام بنشر ديسمبر 16, 2013 قام بنشر ديسمبر 16, 2013 ضع هذا الكود فى موديل 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)
قنديل الصياد قام بنشر ديسمبر 16, 2013 قام بنشر ديسمبر 16, 2013 (معدل) اخى العزيز انظر المرفق ( تفقيط باللغة الانجليزية ) Book1.rar تم تعديل ديسمبر 16, 2013 بواسطه قنديل الصياد
قنديل الصياد قام بنشر ديسمبر 16, 2013 قام بنشر ديسمبر 16, 2013 (معدل) الكود المستخدم فى التفقيط باللغة الانجليزية 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) تم تعديل ديسمبر 16, 2013 بواسطه قنديل الصياد
wlid قام بنشر ديسمبر 30, 2013 قام بنشر ديسمبر 30, 2013 اخى العزيز انظر المرفق (تفقيط باللغة العربية ) بارك الله فيك ومشكور على هذا المجهود .. لكن اخي الكريم لم استطع كتابة كلمة ( فقط ) وكلمة ( دينار ) وكلمة (درهم ) وكلمة (لا غير ) مثل 1358.526= فقط الف وثلاثمائة وثمانية وخمسون دينار و خمسمائة وستة وعشرون درهم لا غير Book1.rar 1
قنديل الصياد قام بنشر ديسمبر 31, 2013 قام بنشر ديسمبر 31, 2013 اخى العزيز اليك الملف مرة اخرى مضافا اليه كلمة لاغير Book1.rar
wlid قام بنشر ديسمبر 31, 2013 قام بنشر ديسمبر 31, 2013 بارك الله فيك تعبناك معانا .. وجعله الله في ميزان حسناتك 837. 9821 قنديل الصياد فقط تسعة آلاف وثمانمائة وواحد وعشرون دينار و درهم لا غير
قنديل الصياد قام بنشر ديسمبر 31, 2013 قام بنشر ديسمبر 31, 2013 اخى العزيز اليك الملف بعد تفقيط المبلغ الذى اوردته وهو 9821.83 Book1.rar
wlid قام بنشر يناير 4, 2014 قام بنشر يناير 4, 2014 بارك الله فيك وزادك الله علما ــ ومشكور على مجهوداتك .. وحرصك واهتمامك ,, وكثر الله من امثالك
قنديل الصياد قام بنشر يناير 4, 2014 قام بنشر يناير 4, 2014 (معدل) تم تعديل يناير 4, 2014 بواسطه قنديل الصياد
الردود الموصى بها
Join the conversation
You can post now and register later. If you have an account, sign in now to post with your account.