aziz77 بتاريخ: 7 يونيو 2006 تقديم بلاغ مشاركة بتاريخ: 7 يونيو 2006 هل يمكن باكسس تحويل الأرقام الي ارقام حروف مثل رقم ( 125 ريال) هل يمكن تحويلة الي (مائة و خمسة و عشرون ريال) قمت بعمل نموذج للقيود اليومية و اريد اضع خاصية كتابة الأرقام أليا فكيف يمكن ذلك في اكسس ممكن بالتفصيل لو سمحتم انا مببتدئ في اكسس و اتمنا لكم التوفيق رابط هذا التعليق شارك المزيد من خيارات المشاركة
webmaster بتاريخ: 13 يونيو 2006 تقديم بلاغ مشاركة بتاريخ: 13 يونيو 2006 (معدل) أخي الكريم هذا الكود يحول من الأرقام إلى الحروف و لكن باللغة الأنجليزية و هو بالطبع بلغة الفيجوال بيسك للتطبيقات المرفقة مع قواعد بيانات أكسس و يمكنك وضع الكود في MODULE و تسميه NumberToWrod و تقوم بعمل اللازم بعد ذلك و الكود هو [B][SIZE=6][B][SIZE=3]Function ConvertCurrencyToEnglish(ByVal mynumber) Dim Temp Dim Dollars, Cents Dim DecimalPlace, Count ReDim Place(9) As String Place(2) = " Thousand " Place(3) = " Million " Place(4) = " Billion " Place(5) = " Trillion " ' Convert MyNumber to a string, trimming extra spaces. If Not mynumber = Null Then mynumber = Trim(Str(mynumber)) End If ' Find decimal place. DecimalPlace = InStr(mynumber, ".") ' If we find decimal place... If DecimalPlace > 0 Then ' Convert cents Temp = Left(Mid(mynumber, DecimalPlace + 1) & "00", 2) Cents = ConvertTens(Temp) ' Strip off cents from remainder to convert. mynumber = Trim(Left(mynumber, DecimalPlace - 1)) End If Count = 1 Do While mynumber <> "" ' Convert last 3 digits of MyNumber to English dollars. Temp = ConvertHundreds(Right(mynumber, 3)) If Temp <> "" Then Dollars = Temp & Place(Count) & Dollars If Len(mynumber) > 3 Then ' Remove last 3 converted digits from MyNumber. mynumber = Left(mynumber, Len(mynumber) - 3) Else mynumber = "" End If Count = Count + 1 Loop ' Clean up dollars. Select Case Dollars Case "" Dollars = "Zero Dirham" Case "One" Dollars = "One Dirham" Case Else Dollars = Dollars & " Dirhams" End Select ' Clean up cents. Select Case Cents Case "" Cents = " And Zero Fils Only." Case "One" Cents = " And One Fils Only." Case Else Cents = " And " & Cents & " Fils Only." End Select ConvertCurrencyToEnglish = Dollars & Cents End Function Private Function ConvertHundreds(ByVal mynumber) Dim Result As String ' Exit if there is nothing to convert. If Val(mynumber) = 0 Then Exit Function ' Append leading zeros to number. mynumber = Right("000" & mynumber, 3) ' Do we have a hundreds place digit to convert? If Left(mynumber, 1) <> "0" Then Result = ConvertDigit(Left(mynumber, 1)) & " Hundred " End If ' Do we have a tens place digit to convert? If Mid(mynumber, 2, 1) <> "0" Then Result = Result & ConvertTens(Mid(mynumber, 2)) Else ' If not, then convert the ones place digit. Result = Result & ConvertDigit(Mid(mynumber, 3)) End If ConvertHundreds = Trim(Result) End Function Private Function ConvertTens(ByVal MyTens) Dim Result As String ' Is value between 10 and 19? If Val(Left(MyTens, 1)) = 1 Then Select Case Val(MyTens) Case 10: Result = "Ten" Case 11: Result = "Eleven" Case 12: Result = "Twelve" Case 13: Result = "Thirteen" Case 14: Result = "Fourteen" Case 15: Result = "Fifteen" Case 16: Result = "Sixteen" Case 17: Result = "Seventeen" Case 18: Result = "Eighteen" Case 19: Result = "Nineteen" Case Else End Select Else ' .. otherwise it's between 20 and 99. Select Case Val(Left(MyTens, 1)) Case 2: Result = "Twenty " Case 3: Result = "Thirty " Case 4: Result = "Forty " Case 5: Result = "Fifty " Case 6: Result = "Sixty " Case 7: Result = "Seventy " Case 8: Result = "Eighty " Case 9: Result = "Ninety " Case Else End Select ' Convert ones place digit. Result = Result & ConvertDigit(Right(MyTens, 1)) End If ConvertTens = Result End Function Private Function ConvertDigit(ByVal MyDigit) Select Case Val(MyDigit) Case 1: ConvertDigit = "One" Case 2: ConvertDigit = "Two" Case 3: ConvertDigit = "Three" Case 4: ConvertDigit = "Four" Case 5: ConvertDigit = "Five" Case 6: ConvertDigit = "Six" Case 7: ConvertDigit = "Seven" Case 8: ConvertDigit = "Eight" Case 9: ConvertDigit = "Nine" Case Else: ConvertDigit = "" End Select[/SIZE] [SIZE=3]End Function[/SIZE][/B][/SIZE][/B] تم تعديل 12 أغسطس 2010 بواسطة admin " قُلِ اللَّهُمَّ مَالِكَ الْمُلْكِ تُؤْتِي الْمُلْكَ مَنْ تَشَاءُ وَتَنْزِعُ الْمُلْكَ مِمَّنْ تَشَاءُ وَتُعِزُّ مَنْ تَشَاءُ وَتُذِلُّ مَنْ تَشَاءُ بِيَدِكَ الْخَيْرُ إِنَّكَ عَلَى كُلِّ شَيْءٍ قَدِيرٌ"مدير الموقع رابط هذا التعليق شارك المزيد من خيارات المشاركة
ATEF SOLIMAN بتاريخ: 4 أغسطس 2006 تقديم بلاغ مشاركة بتاريخ: 4 أغسطس 2006 [align=left:b5d967e570]Function NoToTxt2(TheNo As Double, MyCur As String, MySubCur As String) 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.999 Then Exit Function If TheNo < 0 Then TheNo = TheNo * -1 ReMark = "لم يتبقي " Else ReMark = "فقط " End If If TheNo = 0 Then NoToTxt2 = "صفر" 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 = Round(TheNo, 3) GetNo = Format(TheNo, "000000000000.000") I = 0 '=============== Do While I < 16 If I < 12 Then Myno = Mid$(GetNo, I + 1, 3) Else Myno = Mid$(GetNo, I + 2, 3) + "0" ' "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 NoToTxt2 = ReMark + Mybillion + MyMillion + MyThou + MyHun + " " + MyCur + MyAnd + MyFraction + " " + MySubCur Else NoToTxt2 = ReMark + MyFraction + " " + MySubCur End If Else NoToTxt2 = ReMark + Mybillion + MyMillion + MyThou + MyHun + " " + MyCur End If End Function[/align:b5d967e570] رابط هذا التعليق شارك المزيد من خيارات المشاركة
moatazezat بتاريخ: 11 فبراير 2007 تقديم بلاغ مشاركة بتاريخ: 11 فبراير 2007 السلام عليكم ورحمه الله وبركاته اضافة رائعة ولو ممكن توضح لنا طريقة التحويل فى الاكسيل رابط هذا التعليق شارك المزيد من خيارات المشاركة
brownknight6 بتاريخ: 2 مارس 2007 تقديم بلاغ مشاركة بتاريخ: 2 مارس 2007 هذا برنامج بالاكسس للتفقيط منقووول____144.rar 1 رابط هذا التعليق شارك المزيد من خيارات المشاركة
sa2000 بتاريخ: 1 ديسمبر 2007 تقديم بلاغ مشاركة بتاريخ: 1 ديسمبر 2007 " قَالُوا سُبْحَانَكَ لَا عِلْمَ لَنَا إِلَّا مَا عَلَّمْتَنَا إِنَّكَ أَنْتَ الْعَلِيمُ الْحَكِيمُ" شكراً جزيلاً رابط هذا التعليق شارك المزيد من خيارات المشاركة
shafi بتاريخ: 10 مايو 2009 تقديم بلاغ مشاركة بتاريخ: 10 مايو 2009 السلام عليكم ورحمة الله وبركاته بصراحة الموضوع جميل جدا ويستحق الاهتمام،، أنا الآن عملت برنامج عن طريق الاكسس يخص المحاسبة لكن أرغب في أن يكون التفقيط بالاحرف عن طريق البرنامج مثل طلب الاخ عزيز وأيضاً أنا مبتديء وأريد الشرح بالتفصيل ،، فضلاً لا أمرا طبعا وتحياتي للجميع رابط هذا التعليق شارك المزيد من خيارات المشاركة
أبونصر الله بتاريخ: 19 فبراير 2010 تقديم بلاغ مشاركة بتاريخ: 19 فبراير 2010 شكرا جزيلا على هذا الموضوع القيم ولكن للإستفادة أكثر أرجو أن تزودينا بكود حول كيفية تحويل التاريخ إلى نص رابط هذا التعليق شارك المزيد من خيارات المشاركة
احمد الرازي بتاريخ: 20 فبراير 2010 تقديم بلاغ مشاركة بتاريخ: 20 فبراير 2010 السلام عليكم ورحمة الله وبركاته بصراحة الموضوع جميل جدا ويستحق الاهتمام،، جزاكم الله خيرا وتحياتي للجميع رابط هذا التعليق شارك المزيد من خيارات المشاركة
amrrbacos بتاريخ: 9 مارس 2010 تقديم بلاغ مشاركة بتاريخ: 9 مارس 2010 مشكووووووووووووووووووووووور رابط هذا التعليق شارك المزيد من خيارات المشاركة
ammaree بتاريخ: 24 مارس 2010 تقديم بلاغ مشاركة بتاريخ: 24 مارس 2010 الشكر الجزيل لهذا الموضوع , جزاكم الله كل الخير رابط هذا التعليق شارك المزيد من خيارات المشاركة
ahmed mahfuz بتاريخ: 5 سبتمبر 2010 تقديم بلاغ مشاركة بتاريخ: 5 سبتمبر 2010 الف شكر رابط هذا التعليق شارك المزيد من خيارات المشاركة
جي اي اس بتاريخ: 22 سبتمبر 2010 تقديم بلاغ مشاركة بتاريخ: 22 سبتمبر 2010 (معدل) مشكور تم تعديل 22 سبتمبر 2010 بواسطة ashrafabdulwahed تكرار الحروف رابط هذا التعليق شارك المزيد من خيارات المشاركة
jamal_faiye بتاريخ: 12 مارس 2019 تقديم بلاغ مشاركة بتاريخ: 12 مارس 2019 On 8/4/2006 at 8:51 PM, ATEF SOLIMAN said: [align=left:b5d967e570] Function NoToTxt2(TheNo As Double, MyCur As String, MySubCur As String) 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.999 Then Exit Function If TheNo < 0 Then TheNo = TheNo * -1 ReMark = "لم يتبقي " Else ReMark = "فقط " End If If TheNo = 0 Then NoToTxt2 = "صفر" 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 = Round(TheNo, 3) GetNo = Format(TheNo, "000000000000.000") I = 0 '=============== Do While I < 16 If I < 12 Then Myno = Mid$(GetNo, I + 1, 3) Else Myno = Mid$(GetNo, I + 2, 3) + "0" ' "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 NoToTxt2 = ReMark + Mybillion + MyMillion + MyThou + MyHun + " " + MyCur + MyAnd + MyFraction + " " + MySubCur Else NoToTxt2 = ReMark + MyFraction + " " + MySubCur End If Else NoToTxt2 = ReMark + Mybillion + MyMillion + MyThou + MyHun + " " + MyCur End If End Function [/align:b5d967e570] جزاك الله خيرا مع اضافة السطر الاول Dim MyArry1(0 To 9) As String ابدعت ماشاء الله عليك رابط هذا التعليق شارك المزيد من خيارات المشاركة
Recommended Posts
انشئ حساب جديد أو قم بتسجيل دخولك لتتمكن من إضافة تعليق جديد
يجب ان تكون عضوا لدينا لتتمكن من التعليق
انشئ حساب جديد
سجل حسابك الجديد لدينا في الموقع بمنتهي السهوله .
سجل حساب جديدتسجيل دخول
هل تمتلك حساب بالفعل؟ سجل دخولك من هنا.
سجل دخولك الان