اذهب الي المحتوي
أوفيسنا

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


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

كيف يمكنني تحويل التاريخ من عادي الى نص أي : 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

رابط هذا التعليق
شارك

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

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

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

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

رابط هذا التعليق
شارك

السلام عليكم

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

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


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

تم تعديل بواسطه يوسف عطا
رابط هذا التعليق
شارك

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

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

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

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

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

رابط هذا التعليق
شارك

من فضلك سجل دخول لتتمكن من التعليق

ستتمكن من اضافه تعليقات بعد التسجيل



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

    • لايوجد اعضاء مسجلون يتصفحون هذه الصفحه
×
×
  • اضف...

Important Information