تساؤل كيفية تحويل التاريخ الى نص

[عبد الغني1]

كيف يمكنني تحويل التاريخ من عادي الى نص أي : 01/01/2012 تحول الى في الأول من شهر جانفي سنة ألفين واثنى عشرة

وعندما أضيف الى التاريخ رقم معين مثلا 2 يقوم بإضافة الرقم الى التاريخ يصبح التاريخ : 03/01/2012

تاريخ.rar

[الـعيدروس]

السلام عليكم

اما عن طريق تنسيق خلايا ثم مخصص

وتدرج هذا الرمز

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

[عبد الغني1]

شكرا أخي الفاضل "عباد" هل توجد طريقة بالإكسل لو أمكن وشكرا

[أبو محمد عباس]

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

جزاك الله خيرا استاذ ابو نصار المحترم وبعد اذنك اطبق الدالة والكود بالنيابة عنك حتى نتعلم ولك كل احترامي وتقديري

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

تطبيق الكود والمعادلة.rar

[عبد الغني1]

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

[يوسف عطا]

السلام عليكم

أحيييكم على الأفكار الجميلة والجديدة

ويمكن تعديل بسيط فى تنسيق الخلية لإضافة اليوم كالتالى

dddd dd"  من شهر "mmmm" سنة "yyyy

تم تعديل ديسمبر 12, 2012 بواسطه يوسف عطا

[أبو محمد عباس]

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

الاستاذ الفاضل يوسف جزاك الله خيرا معادلة رائعة

الاخ العزيز largot2009 المحترم ارسلت لك ملفك نفسه لكن غيرت فيه امتداده حيث كان قبل ادخال الكود xlsx وبعد ادخال الكود يجب ان يكون امتداده Xlsm حتى يعمل الماكرو

علما ان الكود والمعادلة تعمل معاي بشكل ممتاز وعلى اي حال قم بتغيير ما قمت بشرحه داخل الملف المرفق ربما تحل المشكله

تطبيق الكود والمعادلةمع الشرح.rar