عمر طاهر قام بنشر مارس 7, 2022 قام بنشر مارس 7, 2022 السلام عليكم و رحمة الله هل يوجد دالة او طريقة لكتابة التاريخ بالحروف ...؟ مثلا ... 10/03/2020 أريده ... العاشر من آذار لعام ألفان و عشرون أرجو التكرم لو وجد
عبدالقدوس48 قام بنشر مارس 7, 2022 قام بنشر مارس 7, 2022 وعليكم السلام ورحمة الله وبركاته يوجد دالة الفرنسية أنت غير فيها Function ConversionHeures(Nombre As Integer) As String If Nombre = 0 Or Nombre = 24 Then ConversionHeures = "Minuit " Exit Function ElseIf Nombre = 12 Then ConversionHeures = "Midi " Exit Function End If Const stEspace As String = " " Dim Varnum, VarnumD, VarnumU, Resultat, Varlet Static Chiffre(1 To 19) Chiffre(1) = "une" Chiffre(2) = "deux" Chiffre(3) = "trois" Chiffre(4) = "quatre" Chiffre(5) = "cinq" Chiffre(6) = "six" Chiffre(7) = "sept" Chiffre(8) = "huit" Chiffre(9) = "neuf" Chiffre(10) = "dix" Chiffre(11) = "onze" Chiffre(12) = "douze" Chiffre(13) = "treize" Chiffre(14) = "quatorze" Chiffre(15) = "quinze" Chiffre(16) = "seize" Chiffre(17) = "dix-sept" Chiffre(18) = "dix-huit" Chiffre(19) = "dix-neuf" Static dizaine(1 To 9, 1 To 5) dizaine(1, 1) = "dix" dizaine(2, 1) = "vingt" dizaine(3, 1) = "trente" dizaine(4, 1) = "quarante" dizaine(5, 1) = "cinquante" dizaine(6, 1) = "soixante" dizaine(7, 1) = "soixante" dizaine(8, 1) = "quatre-vingt" dizaine(9, 1) = "quatre-vingt" Resultat = "" Varnum = Int(Nombre) Mod 1000 If Varnum > 0 Then GoSub centaine_dizaine Resultat = Resultat + " " + Varlet End If Resultat = LTrim(Resultat) Varlet = Right$(Resultat, 4) 'traitement du "s" final pour vingt et cent Select Case Varlet Case "cent", "ingt" Resultat = Resultat + "s" End Select FinTraitement: Resultat = Resultat + stEspace 'renvoi du résultat de la fonction et fin de la fonction ConversionHeures = Replace(Resultat, " ", " ") Exit Function 'sous programme centaine_dizaine: Varlet = "" 'traitement des centaines If Varnum >= 100 Then Varlet = Chiffre(Int(Varnum / 100)) Varnum = Varnum Mod 100 If Varlet = "un" Then Varlet = "cent " Else Varlet = Varlet + " cent " End If End If 'traitement des dizaines If Varnum <= 19 Then If Varnum > 0 Then: Varlet = Varlet + Chiffre(Varnum) Else VarnumD = Int(Varnum / 10) VarnumU = Varnum Mod 10 Varlet = Varlet + dizaine(VarnumD, 1) If VarnumU = 1 And VarnumD < 8 Then Varlet = Varlet + " et " Else If VarnumU <> 0 Or VarnumD = 7 Or VarnumD = 9 Then: Varlet = Varlet & " " End If If VarnumD = 7 Or VarnumD = 9 Then: VarnumU = VarnumU + 10 If VarnumU <> 0 Then: Varlet = Varlet + Chiffre(VarnumU) End If Varlet = Trim(Varlet) Return End Function للعم الشهر يأخذه من نظام الكمبيوتر 1
Moosak قام بنشر مارس 7, 2022 قام بنشر مارس 7, 2022 استخدم هذا الكود أخي عمر .. وهو بالعربي .. تضعه في موديول منفصل ثم تستدعيه كما هو موضح بالأسفل مثال : Public Function DateAsText(GivenDate As Date) As String Dim Daytxt, Monthtxt, Yeartxt As String Daytxt = NoToTxt(Day(GivenDate), "", "") 'Monthtxt = "من شهر " & NoToTxt(Month(GivenDate), "", "") ' فعل هذا السطر إذا أردت كتابة الشهر بالرقم وليس بالاسم Monthtxt = "من شهر " & MonthName(Month(GivenDate)) Yeartxt = "سنة" & NoToTxt(Year(GivenDate), "", "") DateAsText = Daytxt & "" & Monthtxt & " " & Yeartxt & "ميلادي" End Function 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 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 وطريقة استدعائه (كمصدر للخلية أو في الاستعلام) كالتالي : = DateAsText([Date]) 2
الحلبي قام بنشر مارس 7, 2022 قام بنشر مارس 7, 2022 استاذنا/ @Moosak لو سمحت ياريت ترفق مثال لان عند نسخ المويل يطلع كل الكلام بالعربى الى علامات استفهام جزاك الله كل خير
jjafferr قام بنشر مارس 7, 2022 قام بنشر مارس 7, 2022 في 7/3/2022 at 16:36, الحلبي said: نسخ المويل يطلع كل الكلام بالعربى الى علامات استفهام Expand دكتور حلبي 🙂 راح اخبرك سر ، وبس اخبره للعزيزين 🙂 تأكد من ان لغة لوحة المفاتيح باللغة العربية عند النسخ . وكذلك عند اللصق 🙂 جعفر 3
Moosak قام بنشر مارس 7, 2022 قام بنشر مارس 7, 2022 في 7/3/2022 at 16:36, الحلبي said: ياريت ترفق مثال Expand تفضل يا حلبي 🙂 تنصيص التواريخ.accdbFetching info... 2
الحلبي قام بنشر مارس 7, 2022 قام بنشر مارس 7, 2022 في 7/3/2022 at 16:40, jjafferr said: راح اخبرك سر ، وبس اخبره للعزيزين Expand سر غالى من اخ ومعلم غالى الله يرضى عنك ويرزقك من غير حساب ولكن سؤالى : هو مفيش حاجة فى الكمبيوتر ما تعرفهاش ـ كل شئ تعرفه ا في 7/3/2022 at 16:47, Moosak said: تفضل يا حلبي Expand ياسلام عليك مبدع وعبقرى جزاك الله كل خير وبارك الله فيك ورزقك الجنة جزاكم الله كل خير 1
ازهر عبد العزيز قام بنشر مارس 7, 2022 قام بنشر مارس 7, 2022 في 7/3/2022 at 16:58, الحلبي said: ولكن سؤالى : هو مفيش حاجة فى الكمبيوتر ما تعرفهاش ـ كل شئ تعرفه Expand مشعوذ
الحلبي قام بنشر مارس 7, 2022 قام بنشر مارس 7, 2022 في 7/3/2022 at 17:07, ازهر عبد العزيز said: مشعوذ Expand وانت الصادق مبدع وعبقرى وفنان
jjafferr قام بنشر مارس 7, 2022 قام بنشر مارس 7, 2022 في 7/3/2022 at 16:58, الحلبي said: ولكن سؤالى : هو مفيش حاجة فى الكمبيوتر ما تعرفهاش ـ كل شئ تعرفه Expand ياااه ، ذكرتني بأيام زماااان 🙂 في 7/3/2022 at 17:10, الحلبي said: في 7/3/2022 at 17:07, ازهر عبد العزيز said: مشعوذ Expand وانت الصادق مبدع وعبقرى وفنان Expand المهم اني اعرف ان المقصود هو جعفر 🙂
Eng.Qassim قام بنشر مارس 7, 2022 قام بنشر مارس 7, 2022 في 7/3/2022 at 16:58, الحلبي said: هو مفيش حاجة فى الكمبيوتر ما تعرفهاش ـ كل شئ تعرفه Expand 🤣نحتاج بخور من العين
عمر طاهر قام بنشر مارس 8, 2022 الكاتب قام بنشر مارس 8, 2022 في 7/3/2022 at 11:16, عبدالقدوس48 said: وعليكم السلام ورحمة الله وبركاته يوجد دالة الفرنسية أنت غير فيها Function ConversionHeures(Nombre As Integer) As String If Nombre = 0 Or Nombre = 24 Then ConversionHeures = "Minuit " Exit Function ElseIf Nombre = 12 Then ConversionHeures = "Midi " Exit Function End If Const stEspace As String = " " Dim Varnum, VarnumD, VarnumU, Resultat, Varlet Static Chiffre(1 To 19) Chiffre(1) = "une" Chiffre(2) = "deux" Chiffre(3) = "trois" Chiffre(4) = "quatre" Chiffre(5) = "cinq" Chiffre(6) = "six" Chiffre(7) = "sept" Chiffre(8) = "huit" Chiffre(9) = "neuf" Chiffre(10) = "dix" Chiffre(11) = "onze" Chiffre(12) = "douze" Chiffre(13) = "treize" Chiffre(14) = "quatorze" Chiffre(15) = "quinze" Chiffre(16) = "seize" Chiffre(17) = "dix-sept" Chiffre(18) = "dix-huit" Chiffre(19) = "dix-neuf" Static dizaine(1 To 9, 1 To 5) dizaine(1, 1) = "dix" dizaine(2, 1) = "vingt" dizaine(3, 1) = "trente" dizaine(4, 1) = "quarante" dizaine(5, 1) = "cinquante" dizaine(6, 1) = "soixante" dizaine(7, 1) = "soixante" dizaine(8, 1) = "quatre-vingt" dizaine(9, 1) = "quatre-vingt" Resultat = "" Varnum = Int(Nombre) Mod 1000 If Varnum > 0 Then GoSub centaine_dizaine Resultat = Resultat + " " + Varlet End If Resultat = LTrim(Resultat) Varlet = Right$(Resultat, 4) 'traitement du "s" final pour vingt et cent Select Case Varlet Case "cent", "ingt" Resultat = Resultat + "s" End Select FinTraitement: Resultat = Resultat + stEspace 'renvoi du résultat de la fonction et fin de la fonction ConversionHeures = Replace(Resultat, " ", " ") Exit Function 'sous programme centaine_dizaine: Varlet = "" 'traitement des centaines If Varnum >= 100 Then Varlet = Chiffre(Int(Varnum / 100)) Varnum = Varnum Mod 100 If Varlet = "un" Then Varlet = "cent " Else Varlet = Varlet + " cent " End If End If 'traitement des dizaines If Varnum <= 19 Then If Varnum > 0 Then: Varlet = Varlet + Chiffre(Varnum) Else VarnumD = Int(Varnum / 10) VarnumU = Varnum Mod 10 Varlet = Varlet + dizaine(VarnumD, 1) If VarnumU = 1 And VarnumD < 8 Then Varlet = Varlet + " et " Else If VarnumU <> 0 Or VarnumD = 7 Or VarnumD = 9 Then: Varlet = Varlet & " " End If If VarnumD = 7 Or VarnumD = 9 Then: VarnumU = VarnumU + 10 If VarnumU <> 0 Then: Varlet = Varlet + Chiffre(VarnumU) End If Varlet = Trim(Varlet) Return End Function للعم الشهر يأخذه من نظام الكمبيوتر Expand الاستدعاء ...؟ في 7/3/2022 at 16:14, Moosak said: استخدم هذا الكود أخي عمر .. وهو بالعربي .. تضعه في موديول منفصل ثم تستدعيه كما هو موضح بالأسفل مثال : Public Function DateAsText(GivenDate As Date) As String Dim Daytxt, Monthtxt, Yeartxt As String Daytxt = NoToTxt(Day(GivenDate), "", "") 'Monthtxt = "من شهر " & NoToTxt(Month(GivenDate), "", "") ' فعل هذا السطر إذا أردت كتابة الشهر بالرقم وليس بالاسم Monthtxt = "من شهر " & MonthName(Month(GivenDate)) Yeartxt = "سنة" & NoToTxt(Year(GivenDate), "", "") DateAsText = Daytxt & "" & Monthtxt & " " & Yeartxt & "ميلادي" End Function 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 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 وطريقة استدعائه (كمصدر للخلية أو في الاستعلام) كالتالي : = DateAsText([Date]) Expand مشكور جهدك اخي
الردود الموصى بها
Join the conversation
You can post now and register later. If you have an account, sign in now to post with your account.