slamco2000 قام بنشر يناير 18, 2018 قام بنشر يناير 18, 2018 السلام عليكم ورحمة الله وبركاتههل من الممكن مساعدتي في تعديل تفقيط الأرقام بالدينارحيث إني أفتقد القراءة في الفاصلة العشرية الثالثةوإذا ممكن وجود كلمة And من بعد الدينار. أو أي تفقيط جديد يتعامل بالدينار والفلس باللغة الإنجليزيةولكم مني الشكر والتقدير Option Compare Database Option Explicit Function ConvertCurrencyToEnglish(ByVal MyNumber) Dim Temp Dim Dinars, Fils Dim DecimalPlace, Count ReDim Place(9) As String Place(2) = " Thousand " Place(3) = " Million " Place(4) = " Billion " Place(5) = " Trillion " MyNumber = Trim(Str(MyNumber)) DecimalPlace = InStr(MyNumber, ".") If DecimalPlace > 0 Then Temp = Left(Mid(MyNumber, DecimalPlace + 1) & "00", 2) Fils = ConvertTens(Temp) MyNumber = Trim(Left(MyNumber, DecimalPlace - 1)) End If Count = 1 Do While MyNumber <> "" Temp = ConvertHundreds(Right(MyNumber, 3)) If Temp <> "" Then Dinars = Temp & Place(Count) & Dinars If Len(MyNumber) > 3 Then MyNumber = Left(MyNumber, Len(MyNumber) - 3) Else MyNumber = "" End If Count = Count + 1 Loop Select Case Dinars Case "" Dinars = "Zero Dinar" Case "One" Dinars = "One Dinar" Case Else Dinars = Dinars & " Dinars" End Select Select Case Fils Case "" Fils = " Zero Fils Only" Case "One" Fils = " And One Fils Only" Case Else Fils = " And " & Fils & " Fils Only" End Select ConvertCurrencyToEnglish = Dinars & Fils 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 Private Function ConvertHundreds(ByVal MyNumber) Dim Result As String If Val(MyNumber) = 0 Then Exit Function MyNumber = Right("000" & MyNumber, 3) If Left(MyNumber, 1) <> "0" Then Result = ConvertDigit(Left(MyNumber, 1)) & " Hundred " End If If Mid(MyNumber, 2, 1) <> "0" Then Result = Result & ConvertTens(Mid(MyNumber, 2)) Else Result = Result & ConvertDigit(Mid(MyNumber, 3)) End If ConvertHundreds = Trim(Result) End Function Private Function ConvertTens(ByVal MyTens) Dim Result As String 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 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 Result = Result & ConvertDigit(Right(MyTens, 1)) End If ConvertTens = Result End Function
طاهر الوليدي قام بنشر يناير 19, 2018 قام بنشر يناير 19, 2018 هذا مثال طبقه حول كلمة التفقيط فى اكسس.rar
محمد التميمي قام بنشر يناير 19, 2018 قام بنشر يناير 19, 2018 تفضل اخي مثال جاهز بالدينار اكتب الرقم واضغط انتر تفقيط الارقام بالدينار.rar
slamco2000 قام بنشر يناير 19, 2018 الكاتب قام بنشر يناير 19, 2018 3 ساعات مضت, محمد التميمي said: تفضل اخي مثال جاهز بالدينار اكتب الرقم واضغط انتر تفقيط الارقام بالدينار.rar اخي يوجد بها خلل زز لا تقرأ الأرقام والناتج دائماً صفر هل لديك ملف آخر باللغة الإنجليزية ولك الشكر أخي 4 ساعات مضت, طاهر الوليدي said: هذا مثال طبقه حول كلمة التفقيط فى اكسس.rar اخي يوجد بها خلل لا تقرأ الأرقام والناتج دائماً صفر هل لديك ملف آخر باللغة الإنجليزية ولك الشكر أخي
slamco2000 قام بنشر يناير 26, 2018 الكاتب قام بنشر يناير 26, 2018 (معدل) في 1/19/2018 at 14:55, طاهر الوليدي said: هذا مثال طبقه حول كلمة التفقيط فى اكسس.rar أخي الكريم هذا التفقيط باللغة العربية هل ممكن الحصول على تفقيط باللغة الإنجليزية بالدينار والفلس ويقرأ 3 أرقام بعد الفاصلة العشرية ولكم مني كل الشكر والإمتنان تم تعديل يناير 26, 2018 بواسطه slamco2000
طاهر الوليدي قام بنشر يناير 26, 2018 قام بنشر يناير 26, 2018 هذا الكود ضعه في موديل وحدة نمطية Option Explicit 'Main Function Function SpellNumber(ByVal MyNumber) Dim Dollars, Cents, Temp Dim DecimalPlace, Count ReDim Place(9) As String Place(2) = " Thousand " Place(3) = " Million " Place(4) = " Billion " Place(5) = " Trillion " ' String representation of amount. MyNumber = Trim(Str(MyNumber)) ' Position of decimal place 0 if none. DecimalPlace = InStr(MyNumber, ".") ' Convert cents and set MyNumber to dollar amount. If DecimalPlace > 0 Then Cents = GetTens(Left(Mid(MyNumber, DecimalPlace + 1) & _ "00", 2)) MyNumber = Trim(Left(MyNumber, DecimalPlace - 1)) End If Count = 1 Do While MyNumber <> "" Temp = GetHundreds(Right(MyNumber, 3)) If Temp <> "" Then Dollars = Temp & Place(Count) & Dollars If Len(MyNumber) > 3 Then MyNumber = Left(MyNumber, Len(MyNumber) - 3) Else MyNumber = "" End If Count = Count + 1 Loop Select Case Dollars Case "" Dollars = "No Dollars" Case "One" Dollars = "One Dollar" Case Else Dollars = Dollars & " Dollars" End Select Select Case Cents Case "" Cents = " and No Cents" Case "One" Cents = " and One Cent" Case Else Cents = " and " & Cents & " Cents" End Select SpellNumber = Dollars & Cents End Function ' Converts a number from 100-999 into text Function GetHundreds(ByVal MyNumber) Dim Result As String If Val(MyNumber) = 0 Then Exit Function MyNumber = Right("000" & MyNumber, 3) ' Convert the hundreds place. If Mid(MyNumber, 1, 1) <> "0" Then Result = GetDigit(Mid(MyNumber, 1, 1)) & " Hundred " End If ' Convert the tens and ones place. If Mid(MyNumber, 2, 1) <> "0" Then Result = Result & GetTens(Mid(MyNumber, 2)) Else Result = Result & GetDigit(Mid(MyNumber, 3)) End If GetHundreds = Result End Function ' Converts a number from 10 to 99 into text. Function GetTens(TensText) Dim Result As String Result = "" ' Null out the temporary function value. If Val(Left(TensText, 1)) = 1 Then ' If value between 10-19... Select Case Val(TensText) 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 ' If value between 20-99... Select Case Val(Left(TensText, 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 Result = Result & GetDigit _ (Right(TensText, 1)) ' Retrieve ones place. End If GetTens = Result End Function ' Converts a number from 1 to 9 into text. Function GetDigit(Digit) Select Case Val(Digit) Case 1: GetDigit = "One" Case 2: GetDigit = "Two" Case 3: GetDigit = "Three" Case 4: GetDigit = "Four" Case 5: GetDigit = "Five" Case 6: GetDigit = "Six" Case 7: GetDigit = "Seven" Case 8: GetDigit = "Eight" Case 9: GetDigit = "Nine" Case Else: GetDigit = "" End Select End Function كيفية استخدام نموذج دالة SpellNumber لاستخدام نماذج الدوال لتغيير رقم ليصبح نص مكتوب، استخدم إحدى الطرق الموضحة في الأمثلة التالية: الطريقة الأولى: إدخال مباشر يمكنك تغيير 32.50 ليصبح "اثنين وثلاثين دولارًا وخمسين سنتا" بإدخال الصيغة التالية في خلية: =SpellNumber(32.50) الطريقة الثانية: مرجع الخلية يمكنك الإشارة إلى خلايا أخرى في المصنف. على سبيل المثال، أدخل رقم 32.50 في الخلية A1، واكتب الصيغة التالية في خلية أخرى: =SpellNumber(A1) الطريقة الثالثة: إدراج دالة لاستخدام إدراج دالة، اتبع الخطوات التالية: Excel 2003: حدد الخلية التي تريدها. انقر فوق إدراج دالة على شريط الأدوات القياسي. ضمن أو تحديد فئة، انقر فوق معرفة من قِبل المستخدم. في قائمة تحديد دالة، انقر فوق SpellNumber، ثم انقر فوق موافق. أدخل الرقم أو مرجع الخلية المرادين، ثم انقر فوق موافق. Excel 2007 و 2010: حدد الخلية التي تريدها. انقر فوق إدراج دالة على الشريط الصيغ . ضمن أو تحديد فئة، انقر فوق معرفة من قِبل المستخدم. في قائمة تحديد دالة، انقر فوق SpellNumber، ثم انقر فوق موافق. أدخل الرقم أو مرجع الخلية المرادين، ثم انقر فوق موافق. هذا المثال جاهز من تصميم الاخت زهره Convert_Numbers_into_English_Words.rar
طاهر الوليدي قام بنشر يناير 26, 2018 قام بنشر يناير 26, 2018 عفوا السابق بالريال هذا بدينار بعد التعديل عليه تحويل الارقام الى حروف - انجليزي.rar
محمد التميمي قام بنشر يناير 26, 2018 قام بنشر يناير 26, 2018 اسف اخي العزيز لا يوجد لدي كد للفقيط باللغة الانكليزية مثلما طلبت اما هذا الكد فهو شغال عندي منذ سنوات بصورة ممتازة
طاهر الوليدي قام بنشر يناير 26, 2018 قام بنشر يناير 26, 2018 3 دقائق مضت, محمد التميمي said: اسف اخي العزيز لا يوجد لدي كد للفقيط باللغة الانكليزية مثلما طلبت اما هذا الكد فهو شغال عندي منذ سنوات بصورة ممتازة مافهت قصدك اخي العزيز
slamco2000 قام بنشر يناير 30, 2018 الكاتب قام بنشر يناير 30, 2018 (معدل) شكراً أخي طاهر الوليدي على المجهود المبذول , وفقك الله لكل خير هذا الكود شغال بشكل ممتاز لعملات الريال والجنيه , لأن يقرا رقمين بعد الفاصلة العشرية لو مر عليكم كود يقرا ثلاثة أرقام بعد الفاصلة العشرية باللغة الإنجليزية ... لا تنسونا رحم الله والديكم ألف شكر لكم جميعاً تم تعديل يناير 30, 2018 بواسطه slamco2000
طاهر الوليدي قام بنشر يناير 30, 2018 قام بنشر يناير 30, 2018 اقوى تفقيط محترف من ابو هادي ويعتبر من اعلى مستويات برامج التفقيط عربي وانجليزي فقط ترجم نوع العملة من الجدول فقط تفقيط شامل عربي انجليزي.rar
slamco2000 قام بنشر يناير 30, 2018 الكاتب قام بنشر يناير 30, 2018 منذ ساعه, طاهر الوليدي said: اقوى تفقيط محترف من ابو هادي ويعتبر من اعلى مستويات برامج التفقيط عربي وانجليزي فقط ترجم نوع العملة من الجدول فقط تفقيط شامل عربي انجليزي.rar مشكلته ايضا قراءة الأرقام بعد الفاصلة العشرية لقراءة العدد : 1.235 إنظر لقراءته : one and 0.235000 أرفق لك تفقيط ممتاز ,,,,, فيه نفس المشكلة لكن أفضل ,,, يمكنكم المعاينة ,,, باللغة الإنجليزية للأسف لم أستطع إرفاق الملف بسبب الحجم ونسختها بالأسفل هذه قراءته : One Dinar And 235/Fils Only للفائدة لعل أحد يستفيد منها وألف شكر لك أخي Function English(ByVal N As Currency) As String Const Thousand = 1000@ Const Million = Thousand * Thousand Const Billion = Thousand * Million Const Trillion = Thousand * Billion If (N = 0@) Then English = "Zero": Exit Function Dim Buf As String: If (N < 0@) Then Buf = "negative " Else Buf = "" Dim Frac As Currency: Frac = Abs(N - Fix(N)) If (N < 0@ Or Frac <> 0@) Then N = Abs(Fix(N)) Dim AtLeastOne As Integer: AtLeastOne = N >= 1 If (N >= Trillion) Then Debug.Print N Buf = Buf & EnglishDigitGroup(Int(N / Trillion)) & " Trillion" N = N - Int(N / Trillion) * Trillion ' Mod overflows If (N >= 1@) Then Buf = Buf & " " End If If (N >= Billion) Then Debug.Print N Buf = Buf & EnglishDigitGroup(Int(N / Billion)) & " Billion" N = N - Int(N / Billion) * Billion ' Mod still overflows If (N >= 1@) Then Buf = Buf & " " End If If (N >= Million) Then Debug.Print N Buf = Buf & EnglishDigitGroup(N \ Million) & " Million" N = N Mod Million If (N >= 1@) Then Buf = Buf & " " End If If (N >= Thousand) Then Debug.Print N Buf = Buf & EnglishDigitGroup(N \ Thousand) & " Thousand" N = N Mod Thousand If (N >= 1@) Then Buf = Buf & " " End If If (N >= 1@) Then Debug.Print N Buf = Buf & EnglishDigitGroup(N) End If If (Frac = 0@) Then Buf = Buf & " Dinar Only" ElseIf (Int(Frac * 100@) = Frac * 100@) Then If AtLeastOne Then Buf = Buf & " And " Buf = Buf & Format$(Frac * 100@, "00") & "/100" Else If AtLeastOne Then Buf = Buf & " Dinar And " Buf = Buf & Format$(Frac * 1000@, "000") & "/Fils Only" End If English = Buf End Function ' Support function to be used only by English() Private Function EnglishDigitGroup(ByVal N As Integer) As String Const Hundred = " Hundred" Const One = "One" Const Two = "Two" Const Three = "Three" Const Four = "Four" Const Five = "Five" Const Six = "Six" Const Seven = "Seven" Const Eight = "Eight" Const Nine = "Nine" Dim Buf As String: Buf = "" Dim Flag As Integer: Flag = False 'Do hundreds Select Case (N \ 100) Case 0: Buf = "": Flag = False Case 1: Buf = One & Hundred: Flag = True Case 2: Buf = Two & Hundred: Flag = True Case 3: Buf = Three & Hundred: Flag = True Case 4: Buf = Four & Hundred: Flag = True Case 5: Buf = Five & Hundred: Flag = True Case 6: Buf = Six & Hundred: Flag = True Case 7: Buf = Seven & Hundred: Flag = True Case 8: Buf = Eight & Hundred: Flag = True Case 9: Buf = Nine & Hundred: Flag = True End Select If (Flag <> False) Then N = N Mod 100 If (N > 0) Then If (Flag <> False) Then Buf = Buf & " " Else EnglishDigitGroup = Buf Exit Function End If 'Do tens (except teens) Select Case (N \ 10) Case 0, 1: Flag = False Case 2: Buf = Buf & "Twenty": Flag = True Case 3: Buf = Buf & "Thirty": Flag = True Case 4: Buf = Buf & "Forty": Flag = True Case 5: Buf = Buf & "Fifty": Flag = True Case 6: Buf = Buf & "Sixty": Flag = True Case 7: Buf = Buf & "Seventy": Flag = True Case 8: Buf = Buf & "Eighty": Flag = True Case 9: Buf = Buf & "Ninety": Flag = True End Select If (Flag <> False) Then N = N Mod 10 If (N > 0) Then If (Flag <> False) Then Buf = Buf & "-" Else EnglishDigitGroup = Buf Exit Function End If 'Do ones and teens Select Case (N) Case 0: ' do nothing Case 1: Buf = Buf & One Case 2: Buf = Buf & Two Case 3: Buf = Buf & Three Case 4: Buf = Buf & Four Case 5: Buf = Buf & Five Case 6: Buf = Buf & Six Case 7: Buf = Buf & Seven Case 8: Buf = Buf & Eight Case 9: Buf = Buf & Nine Case 10: Buf = Buf & "Ten" Case 11: Buf = Buf & "Eleven" Case 12: Buf = Buf & "Twelve" Case 13: Buf = Buf & "Thirteen" Case 14: Buf = Buf & "Fourteen" Case 15: Buf = Buf & "Fifteen" Case 16: Buf = Buf & "Sixteen" Case 17: Buf = Buf & "Seventeen" Case 18: Buf = Buf & "Eighteen" Case 19: Buf = Buf & "Nineteen" End Select EnglishDigitGroup = Buf End Function
salimboub24 قام بنشر مارس 25, 2019 قام بنشر مارس 25, 2019 في ٣٠/١/٢٠١٨ at 16:20, slamco2000 said: مشكلته ايضا قراءة الأرقام بعد الفاصلة العشرية لقراءة العدد : 1.235 إنظر لقراءته : one and 0.235000 أرفق لك تفقيط ممتاز ,,,,, فيه نفس المشكلة لكن أفضل ,,, يمكنكم المعاينة ,,, باللغة الإنجليزية للأسف لم أستطع إرفاق الملف بسبب الحجم ونسختها بالأسفل هذه قراءته : One Dinar And 235/Fils Only للفائدة لعل أحد يستفيد منها وألف شكر لك أخي Function English(ByVal N As Currency) As String Const Thousand = 1000@ Const Million = Thousand * Thousand Const Billion = Thousand * Million Const Trillion = Thousand * Billion If (N = 0@) Then English = "Zero": Exit Function Dim Buf As String: If (N < 0@) Then Buf = "negative " Else Buf = "" Dim Frac As Currency: Frac = Abs(N - Fix(N)) If (N < 0@ Or Frac <> 0@) Then N = Abs(Fix(N)) Dim AtLeastOne As Integer: AtLeastOne = N >= 1 If (N >= Trillion) Then Debug.Print N Buf = Buf & EnglishDigitGroup(Int(N / Trillion)) & " Trillion" N = N - Int(N / Trillion) * Trillion ' Mod overflows If (N >= 1@) Then Buf = Buf & " " End If If (N >= Billion) Then Debug.Print N Buf = Buf & EnglishDigitGroup(Int(N / Billion)) & " Billion" N = N - Int(N / Billion) * Billion ' Mod still overflows If (N >= 1@) Then Buf = Buf & " " End If If (N >= Million) Then Debug.Print N Buf = Buf & EnglishDigitGroup(N \ Million) & " Million" N = N Mod Million If (N >= 1@) Then Buf = Buf & " " End If If (N >= Thousand) Then Debug.Print N Buf = Buf & EnglishDigitGroup(N \ Thousand) & " Thousand" N = N Mod Thousand If (N >= 1@) Then Buf = Buf & " " End If If (N >= 1@) Then Debug.Print N Buf = Buf & EnglishDigitGroup(N) End If If (Frac = 0@) Then Buf = Buf & " Dinar Only" ElseIf (Int(Frac * 100@) = Frac * 100@) Then If AtLeastOne Then Buf = Buf & " And " Buf = Buf & Format$(Frac * 100@, "00") & "/100" Else If AtLeastOne Then Buf = Buf & " Dinar And " Buf = Buf & Format$(Frac * 1000@, "000") & "/Fils Only" End If English = Buf End Function ' Support function to be used only by English() Private Function EnglishDigitGroup(ByVal N As Integer) As String Const Hundred = " Hundred" Const One = "One" Const Two = "Two" Const Three = "Three" Const Four = "Four" Const Five = "Five" Const Six = "Six" Const Seven = "Seven" Const Eight = "Eight" Const Nine = "Nine" Dim Buf As String: Buf = "" Dim Flag As Integer: Flag = False 'Do hundreds Select Case (N \ 100) Case 0: Buf = "": Flag = False Case 1: Buf = One & Hundred: Flag = True Case 2: Buf = Two & Hundred: Flag = True Case 3: Buf = Three & Hundred: Flag = True Case 4: Buf = Four & Hundred: Flag = True Case 5: Buf = Five & Hundred: Flag = True Case 6: Buf = Six & Hundred: Flag = True Case 7: Buf = Seven & Hundred: Flag = True Case 8: Buf = Eight & Hundred: Flag = True Case 9: Buf = Nine & Hundred: Flag = True End Select If (Flag <> False) Then N = N Mod 100 If (N > 0) Then If (Flag <> False) Then Buf = Buf & " " Else EnglishDigitGroup = Buf Exit Function End If 'Do tens (except teens) Select Case (N \ 10) Case 0, 1: Flag = False Case 2: Buf = Buf & "Twenty": Flag = True Case 3: Buf = Buf & "Thirty": Flag = True Case 4: Buf = Buf & "Forty": Flag = True Case 5: Buf = Buf & "Fifty": Flag = True Case 6: Buf = Buf & "Sixty": Flag = True Case 7: Buf = Buf & "Seventy": Flag = True Case 8: Buf = Buf & "Eighty": Flag = True Case 9: Buf = Buf & "Ninety": Flag = True End Select If (Flag <> False) Then N = N Mod 10 If (N > 0) Then If (Flag <> False) Then Buf = Buf & "-" Else EnglishDigitGroup = Buf Exit Function End If 'Do ones and teens Select Case (N) Case 0: ' do nothing Case 1: Buf = Buf & One Case 2: Buf = Buf & Two Case 3: Buf = Buf & Three Case 4: Buf = Buf & Four Case 5: Buf = Buf & Five Case 6: Buf = Buf & Six Case 7: Buf = Buf & Seven Case 8: Buf = Buf & Eight Case 9: Buf = Buf & Nine Case 10: Buf = Buf & "Ten" Case 11: Buf = Buf & "Eleven" Case 12: Buf = Buf & "Twelve" Case 13: Buf = Buf & "Thirteen" Case 14: Buf = Buf & "Fourteen" Case 15: Buf = Buf & "Fifteen" Case 16: Buf = Buf & "Sixteen" Case 17: Buf = Buf & "Seventeen" Case 18: Buf = Buf & "Eighteen" Case 19: Buf = Buf & "Nineteen" End Select EnglishDigitGroup = Buf End Function ال السلام عليكم أخي اذا امكن أريده باللغة الفرنسية
الردود الموصى بها
Join the conversation
You can post now and register later. If you have an account, sign in now to post with your account.