adam13

أخوى أبو جاك فعلا عمل رااااااااااااااااااائع جزاء الله عنه كل الخيرات

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

وهذا ياأخى هو الكود للدالة باللغة الانجليزية الذى أقصده ليت أحد الأخوة الافاضل يقوم بالتعديل عليه كى يصبح الفلس يقبل ثلاثة أرقام 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. MyNumber = Trim(Str(MyNumber)) ' 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 = "No Dollars" Case "One" Dollars = "One Dollar" Case Else Dollars = Dollars & " Dollars" End Select ' Clean up cents. Select Case Cents Case "" Cents = " And No Cents" Case "One" Cents = " And One Cent" Case Else Cents = " And " & Cents & " Cents" 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

أخى سالم بارك الله فيك وأسف فى تأخرى عن الرد والمتابعة الدالة التى وضعتها باللغة العربية مظبوطة وتعمل بشكل جيد والملف الثانى رائع بحق ولكنى لا أجد فيه دالة تفقيط الدينار بالعملة الكويتية أقصد أن يكون الفقيط بهذه الصيغة One Hundred Twenty Three Dollars And Ninety Nine Cents والتى توجد فى الموديل باسم AbuHamoudEn (9) ولكن مشكلتها هى أنها تقوم بوضع رقمين عشريين فقط وأشكرك بشدة ياأخى على تعبك

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

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

الملف رائع حقا لكن الدالة الانجليزية كلمة AND غير مظبوطة يلزمها مسافة بعد الرقم

مشكور ياأخى ابو تامر لكنى لم افهم الكود برجاء عمله على المرفق الذى به المعادلة

لعلى اجد لديكم حل للموضوع

كلامك صحيح ياأخى ولكن الفكرة فى أيجاد حل للموضوع بطريقة ألية دون تدخل منى لأننى لو نسيت أن اقوم بذلك سوف أحصل على نتائج خطأ

ولك كل الشكر السلام عليكم وكأنك ياأخى تتكلم عن ما بداخلى ومنتظر مشاركة الاخوة الكرام

السلام عليكم أشكركم بشدة أخوانى الكرام فعلا الاخ samnaj00 هو قام بتوضيح مااريده بالضبط ولقد جربت ملف الاخ أبو أسامة والأخ أحمد ولم ينفع معى

مشكور لك ياأخى ولكن الكود لايعمل ولاأعرف ماهى المشكلة

أخى لقد قمت بتحميل الملف مرة أخرى وعندما حاولت تغيير القيمة فى العامود a وجدت أن المعادلة تتغير معها أرجو تجربة ماأقوله

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

السلام عليكم لقد طلب منى أحد الاصدقاء معادلة معينة والحمدلله توفقت فيها بفضل هذا المنتدى ولكن واجهتنى مشكلة فكيف أقوم بتثبيت ناتج قيمة المعادلة بعد عملها لأول مرة بعيدا عن طريقة النسخ ثم اللصق المتخصص فأنا أعرف هذه الطريقة منتظر مشاركتكم أخوانى فى هذه المشكلة ومرفق ملف به المعادلة وشرح المطلوب New_Microsoft_Office_Excel_Worksheet.rar

فكرة رائعة ياأخى بارك الله فيك

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

مشكور ياأخى على البرنامج الجميل

أشكرك جدا ياأخى ومنتظر مشاركتك

السلام عليكم أشكرك بشدة اخى احمد بارك الله فيك للأسف الفكرة من أن يكون كل يوم على حده هو المتابعة اليومية للسولار لكل يوم على حده فمن الصعب عمل ذلك ولكن إن كانت لديك فكرة لحل المشكلة بشكل أخر حتى لو تم دمج الايام فأنت ياأخى مرحب بك دائما وذلك لأنه لايمكن مقارنتك بى فزدنا بعلمك ياأخى ومنتظر اجابتك

أسف لازعاجكم ولكن إن كان أحد لديه حل فلايبخل به علينا وهذا تعودناه منكم والله الموفق

أخى طارق أشكرك بشدة على عملك الرائع بارك الله بك ولكن هناك نقطة أريد أن أجد لها حلا وهى انه عند أدخال قيمة خاطئة فى العامود E (العداد لحالى) بشرط أن تكون أقل من القيمة فى العامود E ليوم سابق فالمعادلة لاتعمل لأنها تعتمد على أن القراءة الحالية تكون أكبر من القراءة السابقة ولكنى أريد أن تعمل المعادلة بأى شكل لأنه بهذه الطريقة أستطيع أن أكتشف خطأ الادخال وأقوم بتصحيحه ليتنى أجد لديكم الاجابة لأن الموضوع ضرورى

رااااااااااااائع جدا خاصة لضعاف البصرمشكور ياخى والله عينى تؤلمنى من كثرة النظر للشاشة

وأنا أيضا أضم صوتى لصوتك واشكر كل الاخوة الذين ساعدونى ويساعدونى فى ايجاد الحلول لكافة المشاكل التى أواجهها والى الامام دائما