منتديات روكشا     َولَوْلَا إِذْ دَخَلْتَ جَنَّتَكَ قُلْتَ مَا شَاءَ اللَّهُ لَا قُوَّةَ إِلَّا بِاللَّه

الرئيسية |  التسجيل  |  مركز رفع الملفات  |  الاتصال بنا  

 



العودة   منتديات روكشا > المنتدي التخصصي > قسم التصاميم والبرمجة والجرافيكس والميديا > انشاء وتصميم وبرمجة البرامج

الملاحظات

انشاء وتصميم وبرمجة البرامج برنامج الوورد اكسس اكسيل بوربوينت فيجوال بيسك برامج محاسبة برامج ادارة وتنظيم حسابات تنسيق الملفات

إضافة رد
 
أدوات الموضوع انواع عرض الموضوع
  #1  
قديم 03-22-2019, 04:00 PM

الصورة الرمزية ابن الوليد

ابن الوليد

.:: ادارة المنتدي ::.

 
تاريخ التسجيل: Nov 2018
الدولة: مصر
المشاركات: 1,690
معدل تقييم المستوى: 10
ابن الوليد has much to be proud ofابن الوليد has much to be proud ofابن الوليد has much to be proud ofابن الوليد has much to be proud ofابن الوليد has much to be proud ofابن الوليد has much to be proud ofابن الوليد has much to be proud ofابن الوليد has much to be proud of
إرسال رسالة عبر MSN إلى ابن الوليد إرسال رسالة عبر Yahoo إلى ابن الوليد إرسال رسالة عبر Skype إلى ابن الوليدابن الوليد غير متواجد حالياً
فنجان كود تحويل الأرقام إلى حروف في الأكسس

 



اقتباس:
تحويل الأرقام الي ارقام حروف مثل رقم ( 125 ريال) هل يمكن تحويلة الي (مائة و خمسة و عشرون ريال)
هذا الكود يحول من الأرقام إلى الحروف و لكن باللغة الأنجليزية و هو بالطبع بلغة الفيجوال بيسك للتطبيقات المرفقة مع قواعد بيانات أكسس و يمكنك وضع الكود في MODULE و تسميه NumberToWrod و تقوم بعمل اللازم بعد ذلك

و الكود هو


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 End Function
__________________
رد مع اقتباس
إضافة رد

مواقع النشر (المفضلة)


الذين يشاهدون محتوى الموضوع الآن : 1 ( الأعضاء 0 والزوار 1)
 
أدوات الموضوع
انواع عرض الموضوع

تعليمات المشاركة
لا تستطيع إضافة مواضيع جديدة
لا تستطيع الرد على المواضيع
لا تستطيع إرفاق ملفات
لا تستطيع تعديل مشاركاتك

BB code is متاحة
كود [IMG] متاحة
كود HTML معطلة

الانتقال السريع

المواضيع المتشابهه
الموضوع كاتب الموضوع المنتدى مشاركات آخر مشاركة
PopChar 8.3 Build 2923 برنامج مفيد يسمح لك بإدخال حروف خاصة ابن الوليد برامج الحاسب 1 04-02-2019 01:03 PM
شرح Html5: ادخال الأرقام مهرة النجدية ركن تطوير وإدارة المواقع العام 0 02-26-2019 11:07 PM
مقال شرح تنسيق الأرقام في Microsoft Excel مهرة النجدية انشاء وتصميم وبرمجة البرامج 2 02-11-2019 03:30 PM
كتاب حمل نظام التعامل مع الأكسس نفسه الفارس انشاء وتصميم وبرمجة البرامج 0 02-05-2019 07:25 AM
كتاب شرح الأكسس - Access ابن الوليد انشاء وتصميم وبرمجة البرامج 0 02-04-2019 11:13 PM

 

RSS RSS 2.0 XML MAP HTML

الساعة الآن 03:39 AM

نبذة عن المنتدى

روابط مفيدة

إعلانات نصية

روابط الموقع

منتديات روكشا لتقنية المعلومات تقدم كل ما هو جديد ومفيد في عالم البرامج سواء جاهزة أو طرق وشروحات برمجة وتصميم وسوف تجدون أقسام عديدة ومختصة لكل ما تبحث عنه



Powered by vBulletin® Copyright ©2000 - 2019,