عبد الغني1 قام بنشر ديسمبر 11, 2012 مشاركة قام بنشر ديسمبر 11, 2012 كيف يمكنني تحويل التاريخ من عادي الى نص أي : 01/01/2012 تحول الى في الأول من شهر جانفي سنة ألفين واثنى عشرة وعندما أضيف الى التاريخ رقم معين مثلا 2 يقوم بإضافة الرقم الى التاريخ يصبح التاريخ : 03/01/2012 تاريخ.rar رابط هذا التعليق شارك More sharing options...
الـعيدروس قام بنشر ديسمبر 11, 2012 مشاركة قام بنشر ديسمبر 11, 2012 السلام عليكم اما عن طريق تنسيق خلايا ثم مخصص وتدرج هذا الرمز d" من شهر :"mmm" سنة :"yyyy او بالاعتماد على دالة تفقط معرف لااعلم لمن هيا هذا الكود في مودويل Sub Ali_Is_D() Dim R As Range Dim S, C Set R = [B5] S = Split(R.Text, "/") E = NoToTxt(Val(S(0)), "", "") ' السنه Ec = NoToTxt(Val(S(2)), "", "") 'اليوم [C5] = Ec & "من شهر :" & Format(R.Text, "MMM") & " سنة :" & E End Sub وهذه الداله المعرفه في مودويل Function NoToTxt(TheNo As Double, MyCur As String, MySubCur As String) As String Dim MyArry1(0 To 9) As String Dim MyArry2(0 To 9) As String Dim MyArry3(0 To 9) As String Dim Myno As String Dim GetNo As String Dim RdNo As String Dim My100 As String Dim My10 As String Dim My1 As String Dim My11 As String Dim My12 As String Dim GetTxt As String Dim Mybillion As String Dim MyMillion As String Dim MyThou As String Dim MyHun As String Dim MyFraction As String Dim MyAnd As String Dim i As Integer Dim ReMark As String If TheNo > 999999999999.99 Then Exit Function If TheNo < 0 Then TheNo = TheNo * -1 ReMark = " " Else ReMark = " " End If If TheNo = 0 Then NoToTxt = "" Exit Function End If MyAnd = " و" MyArry1(0) = "" MyArry1(1) = "مائة" MyArry1(2) = "مائتان" MyArry1(3) = "ثلاثمائة" MyArry1(4) = "أربعمائة" MyArry1(5) = "خمسمائة" MyArry1(6) = "ستمائة" MyArry1(7) = "سبعمائة" MyArry1(8) = "ثمانمائة" MyArry1(9) = "تسعمائة" MyArry2(0) = "" MyArry2(1) = " عشرة" MyArry2(2) = "عشرون" MyArry2(3) = "ثلاثون" MyArry2(4) = "أربعون" MyArry2(5) = "خمسون" MyArry2(6) = "ستون" MyArry2(7) = "سبعون" MyArry2(8) = "ثمانون" MyArry2(9) = "تسعون" MyArry3(0) = "" MyArry3(1) = "الأول" MyArry3(2) = "الثاني" MyArry3(3) = "الثالث" MyArry3(4) = "الرابع" MyArry3(5) = "الخامس" MyArry3(6) = "السادس" MyArry3(7) = "السابع" MyArry3(8) = "الثامن" MyArry3(9) = "التاسع" '====================== GetNo = Format(TheNo, "000000000000.00") i = 0 Do While i < 15 If i < 12 Then Myno = Mid$(GetNo, i + 1, 3) Else Myno = "0" + Mid$(GetNo, i + 2, 2) End If If (Mid$(Myno, 1, 3)) > 0 Then RdNo = Mid$(Myno, 1, 1) My100 = MyArry1(RdNo) RdNo = Mid$(Myno, 3, 1) My1 = MyArry3(RdNo) RdNo = Mid$(Myno, 2, 1) My10 = MyArry2(RdNo) If Mid$(Myno, 2, 2) = 11 Then My11 = "إحد عشر" If Mid$(Myno, 2, 2) = 12 Then My12 = "اثنا عشر" If Mid$(Myno, 2, 2) = 10 Then My10 = "عشرة" If ((Mid$(Myno, 1, 1)) > 0) And ((Mid$(Myno, 2, 2)) > 0) Then My100 = My100 + MyAnd If ((Mid$(Myno, 3, 1)) > 0) And ((Mid$(Myno, 2, 1)) > 1) Then My1 = My1 + MyAnd GetTxt = My100 + My1 + My10 If ((Mid$(Myno, 3, 1)) = 1) And ((Mid$(Myno, 2, 1)) = 1) Then GetTxt = My100 + My11 If ((Mid$(Myno, 1, 1)) = 0) Then GetTxt = My11 End If If ((Mid$(Myno, 3, 1)) = 2) And ((Mid$(Myno, 2, 1)) = 1) Then GetTxt = My100 + My12 If ((Mid$(Myno, 1, 1)) = 0) Then GetTxt = My12 End If If (i = 0) And (GetTxt <> "") Then If ((Mid$(Myno, 1, 3)) > 10) Then Mybillion = GetTxt + " مليار" Else Mybillion = GetTxt + " مليارات" If ((Mid$(Myno, 1, 3)) = 2) Then Mybillion = " مليار" If ((Mid$(Myno, 1, 3)) = 2) Then Mybillion = " ملياران" End If End If If (i = 3) And (GetTxt <> "") Then If ((Mid$(Myno, 1, 3)) > 10) Then MyMillion = GetTxt + " مليون" Else MyMillion = GetTxt + " ملايين" If ((Mid$(Myno, 1, 3)) = 1) Then MyMillion = " مليون" If ((Mid$(Myno, 1, 3)) = 2) Then MyMillion = " مليونان" End If End If If (i = 6) And (GetTxt <> "") Then If ((Mid$(Myno, 1, 3)) > 10) Then MyThou = GetTxt + " ألف" Else MyThou = GetTxt + " آلاف" If ((Mid$(Myno, 3, 1)) = 1) Then MyThou = " ألف" If ((Mid$(Myno, 3, 1)) = 2) Then MyThou = " ألفان" End If End If If (i = 9) And (GetTxt <> "") Then MyHun = GetTxt If (i = 12) And (GetTxt <> "") Then MyFraction = GetTxt End If i = i + 3 Loop If (Mybillion <> "") Then If (MyMillion <> "") Or (MyThou <> "") Or (MyHun <> "") Then Mybillion = Mybillion + MyAnd End If If (MyMillion <> "") Then If (MyThou <> "") Or (MyHun <> "") Then MyMillion = MyMillion + MyAnd End If If (MyThou <> "") Then If (MyHun <> "") Then MyThou = MyThou + MyAnd End If If MyFraction <> "" Then If (Mybillion <> "") Or (MyMillion <> "") Or (MyThou <> "") Or (MyHun <> "") Then NoToTxt = ReMark + Mybillion + MyMillion + MyThou + MyHun + " " + MyCur + MyAnd + MyFraction + " " + MySubCur Else NoToTxt = ReMark + MyFraction + " " + MySubCur End If Else NoToTxt = ReMark + Mybillion + MyMillion + MyThou + MyHun + " " + MyCur End If End Function رابط هذا التعليق شارك More sharing options...
عبد الغني1 قام بنشر ديسمبر 11, 2012 الكاتب مشاركة قام بنشر ديسمبر 11, 2012 شكرا أخي الفاضل "عباد" هل توجد طريقة بالإكسل لو أمكن وشكرا رابط هذا التعليق شارك More sharing options...
أبو محمد عباس قام بنشر ديسمبر 12, 2012 مشاركة قام بنشر ديسمبر 12, 2012 السلام عليكم ورحمة الله وبركاته جزاك الله خيرا استاذ ابو نصار المحترم وبعد اذنك اطبق الدالة والكود بالنيابة عنك حتى نتعلم ولك كل احترامي وتقديري الاخ العزيز اليك الملف بعد تطبيق الدالة والكود ارجو ان وفقت فيها مع التقدير تطبيق الكود والمعادلة.rar رابط هذا التعليق شارك More sharing options...
عبد الغني1 قام بنشر ديسمبر 12, 2012 الكاتب مشاركة قام بنشر ديسمبر 12, 2012 السلام عليكم أخي عباس الملف الذي أرسلته لايعمل هل تقول لي كيف يعمل ولو امكن من دوال الاكسل ولك جزيل الشكر رابط هذا التعليق شارك More sharing options...
يوسف عطا قام بنشر ديسمبر 12, 2012 مشاركة قام بنشر ديسمبر 12, 2012 (معدل) السلام عليكم أحيييكم على الأفكار الجميلة والجديدة ويمكن تعديل بسيط فى تنسيق الخلية لإضافة اليوم كالتالى dddd dd" من شهر "mmmm" سنة "yyyy تم تعديل ديسمبر 12, 2012 بواسطه يوسف عطا رابط هذا التعليق شارك More sharing options...
أبو محمد عباس قام بنشر ديسمبر 12, 2012 مشاركة قام بنشر ديسمبر 12, 2012 السلام عليكم ورحمة الله وبركاته الاستاذ الفاضل يوسف جزاك الله خيرا معادلة رائعة الاخ العزيز largot2009 المحترم ارسلت لك ملفك نفسه لكن غيرت فيه امتداده حيث كان قبل ادخال الكود xlsx وبعد ادخال الكود يجب ان يكون امتداده Xlsm حتى يعمل الماكرو علما ان الكود والمعادلة تعمل معاي بشكل ممتاز وعلى اي حال قم بتغيير ما قمت بشرحه داخل الملف المرفق ربما تحل المشكله تطبيق الكود والمعادلةمع الشرح.rar رابط هذا التعليق شارك More sharing options...
الردود الموصى بها
من فضلك سجل دخول لتتمكن من التعليق
ستتمكن من اضافه تعليقات بعد التسجيل
سجل دخولك الان