مساعد فى تفقيط الارقام (تفقيط ارقام)

بوحماد · أغسطس 19, 2010

لسلام عليكم ورحمة الله وبركاته

تقبل الله صيامك وجميع اعضاء أوفيسناو بمزيد من الأجر والثواب

نرفق لكم الملف كى تقومو بتعديل تفقيد الارقام وتحويلها من العربية الى انجليزية مثلا

Only six hundred and thirty dinars, and one hundred and thirty dirham

10330.rar

تم تعديل نوفمبر 4, 2011 بواسطه الحسامي

**أيسم إبراهيم** · أغسطس 20, 2010

السلام عليكم

أخي الكريم

تفضل المرفق يمكن يكون به ما تريد

دمت بخير

أيسم إبراهيم

تفقيط.rar

بوحماد · أغسطس 20, 2010

لسلام عليكم ورحمة الله وبركاته

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

المشلة فى العالمة العشرية تظهر خنتان مثلا 100.650 Only Hundred Dinar SixtyFive Derham

والمشلة الثانية ان الوارد الذى عمل علية عربى 2010 وعند وضع هذة الدالة يحول الكتابة بالعربى وانا اريدها بالنجليزى نظر الى المرفق السابق تحياتى

بوحماد · أغسطس 22, 2010

السلام عليكم ورجمتة الله وبركاتة

حولت التوضيح نرفق لكم الملف

10330.rar

**مصطفى كمال** · أغسطس 23, 2010

السلام عليكم ورحمة الله وبركاته

تقبل الله صيام وقيام الجميع بمزيد من الأجر والثواب

أخي الكريم bast وجدت لك ماكرو تحول الأرقام للانجليزي لكن بالدولار والسنت

رجاثي في باقي الإخوة المتخصصين في ٍٍِVBA تحويلها لتتوافق مع كل العملات

الماكرو موجودة في module1

بالتوفيق أخي الكريم bast

10330.rar

**مصطفى كمال** · أغسطس 24, 2010

السلام عليكم ورحمة الله وبركاته

تقبل الله صيام وقيام الجميع بمزيد من الأجر والثواب

أخي الكريم أيسم مبروك الترقية وطلباتك أوامر

تفضل الملف المرفق

10330.rar

**أيسم إبراهيم** · أغسطس 24, 2010

السلام عليكم

أخي مصطفى

بارك الله فيك و جزاك كل خير وشكرا على التهنئة

لكن

الملف المرفق لا يوجد به موديول كود دالة التفقيط.

أرجو مراجعة رفع المكلف بعد إذنك

دمت بخير

أيسم إبراهيم

**مصطفى كمال** · أغسطس 24, 2010

السلام عليكم ورجمة الله وبركاته

تقبل الله صيام وقيام الجميع بمزيد من الأجر والثواب

أخي الكريم أيسم تفضل الملف التالي يوضح لك أين تجد الدالة في الملف

module.rar

**أيسم إبراهيم** · أغسطس 25, 2010

السلام عليكم

أخي مصطفى

الملف الذي أرفقت به نسختان الأولى 2010 و الثانية 2003

نسخة 2003 لا يوجد بها أي موديول و الصورة المرفقة توضح ذلك

no modules.bmp

بوحماد · أغسطس 26, 2010

السلام عليكم ورحمتة الله وبركاتة

استاذنا أيسم ابراهيم ممكن تضع ملف من عندك وتضع فية الكود او الدالة التى تحول بالطريقة اتى انا شرحتها ثم اقوم انا بوضع الكود او الدالة فى الملف الموجود لديا :: 630.130 Only six hundred and thirty dinars, and one hundred and thirty dirham اخى أيسم انا فى انتظر الراد لاننى بحاجة ماسة الى هذة الدالة تحياتى

**مصطفى كمال** · أغسطس 26, 2010

السلام عليكم ورحمة الله وبركاته

تفضل أخي الكريم أيسم الملف المرفق قد يساعدك

رجاء أخي الكريم BSAT ألق نظرة على الملف

10330.rar

**مصطفى كمال** · أغسطس 26, 2010

أخي الكريم أيسم يبدو أن الملف المرفق يحتوي بداخله ماكرو كنظام حماية

فعند تشغيل الملف تظهر رسالة خطأ ثم عند إعادة تشغيل الاكسيل يتم حذف وحدة الماكرو كليا

لا أعرف ما السبب

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

أرجو التوفيق مم قمت به

إليك أخي أيسم كود دالة تحويل من عربي إلى انجليزي بالنسبة لعملة الدولار

 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

بوحماد · أغسطس 26, 2010

مشكور اخى مصطفى الملف الذى رفقتة فية مشلكة واحدة هى ان الدارهم لايكتبها تامة ياخذ االخنتان الاولى والثانية مثلا نكتب 100.300 تظهر One Hundred Dinars And Thirty Dirham

ثلا ثن درارهم والصحيح ثلاثمائة دارهم

**مصطفى كمال** · أغسطس 26, 2010

السلام عليكم ورحمة الله وبركاته

تقبل الله صيام وقيام الجميع بمزيد من الأجر والثواب

اخي الكريم خبرتي في vb محدودة جدا، ارجو أن تجد حلولا من طرف باقي الإخوة

بوحماد · أغسطس 27, 2010

بارك الله فيك اخى مصطفى

**أيسم إبراهيم** · أغسطس 27, 2010

السلام عليكم جميعا

شكرا أخي الأستاذ مصطفي على الكود. تعبناك معانا

أخي الكريم bast

تفضل المرفق تم تعديل الكود ليناسب طلبك

جرب و اخبرني بالنتيجة

دمتم جميعا بخير

أيسم إبراهيم

tafkeet.rar

بوحماد · أغسطس 27, 2010

السلام عليكم اخى ايسم

مشكور على هذا الجهد والهتمام لاكن مازل فية مشكلة مثلا نكتب 100.200 مائة دينار ومائتان دارهم فى الملف المرفق

مائة دينار ووعشرون دارهم One Hundred Dinars And Twenty Derham

المشكلة فى الدراهم باس الباقى تمام نامل تعديل الدرهم تحياتى

**أيسم إبراهيم** · أغسطس 27, 2010

السلام عليكم

أخي الكريم

لي سؤال:

هو الدينار يساوي كام درهم؟؟؟

للتعديل على جبر الكسر في الكود

منتظر ردك

أيسم إبراهيم

بوحماد · أغسطس 27, 2010

السلام عليكم

الدينار يساوى 1000 درهم

**مصطفى كمال** · أغسطس 27, 2010

السلام عليكم ورحمة الله وبركاته

تقبل الله صيام وقيام الجميع بمزيد من الأجر والثواب

تفضل أخي الكريم Bast الملف المرفق ، ارجو أن يكون ما طلبت في انتظار البحث عن دالة أفضل

10330.rar

بوحماد · أغسطس 28, 2010

مشكور اخى مصطفى ماشالله عليك وبارك اله فيك أنت واخى ايسام ابراهيم على هتمامك تقبل الله صيامك

لاكن عند طلب بسيط هل فية طريقة تحول الدراهم الى حروف بدلا من One Hundred Dinar and 200 dirham Only

200 دارهم على العموم مشكورين وبارك الله فيكم جميعا

**مصطفى كمال** · أغسطس 30, 2010

السلام عليكم ورحمة الله وبركاته

تقبل الله صيام وقيام الجميع بمزيد من الأجر والثواب

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

ونحن في العشر الأواخر من رمضان

تفضل أخي الكريم bast الملف المرفق فقد تم توفير طلبك

تم إضافة الملف الأصلي ( قاعدة بيانات اكسس ) موضح فيه طريقة كتابة الدالة وضبطها بالشكل الصحيح

الحمد لله رب العالمين

Bureau.rar

وليد المصرى 1 · نوفمبر 20, 2012

السلام عليكم ورحمة الله \

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

'Option Compare Database

Public ÇáÑÞã_ÑÞãÇð2, ÇáÑÞã_ßÊÇÈÉ2

Public Sub ÊÍæíá_ÇáÑÞã_ßÊÇÈÉ2()

ÇáÑÞã_ÑÞãÇð2 = Round(ÇáÑÞã_ÑÞãÇð2, 2)

Dim ÊÌÑÈÉ, ÑÞã_Ãæáí, ÞÑÇÁÉ_Ãæáì

Dim ÇáÃÑÞÇã_ÈÚÏ_ÇáÝÇÕáÉ

Dim ÑÞã_ÕÝÑí, ÇáÂÍÇÏ, ÇáÚÔÑÇÊ, ÇáãÆÇÊ, ÇáÃáæÝ, ÚÔÑÇÊ_ÇáÃáæÝ, ãÆÇÊ_ÇáÃáæÝ, ãáÇííä

Dim ÇáÝÆÉ As String

Const ÑíÇá = "ÑíÇá"

' ÇáÂÍÇÏ

' ÇáÔÑØ ÇáÊÇáí áÛÑÖ ÚÏã ÅÏÎÇá ÑÞã ÕÍíÍ ÚäÏ æÌæÏ ÑÞã æÇÍÏ ááåááÉ

'MsgBox ÇáÑÞã_ÑÞãÇð2

'MsgBox Fix(ÇáÑÞã_ÑÞãÇð2) * 100

'ÇáÃÑÞÇã_ÈÚÏ_ÇáÝÇÕáÉ = CInt((ÇáÑÞã_ÑÞãÇð2 - Fix(ÇáÑÞã_ÑÞãÇð2)) * 100)

'MsgBox ÇáÃÑÞÇã_ÈÚÏ_ÇáÝÇÕáÉ

If Right([ÇáÑÞã_ÑÞãÇð2], 3) < 1 Then

ÇáÃÑÞÇã_ÈÚÏ_ÇáÝÇÕáÉ = Right([ÇáÑÞã_ÑÞãÇð2], 3)

Else

ÇáÃÑÞÇã_ÈÚÏ_ÇáÝÇÕáÉ = Right([ÇáÑÞã_ÑÞãÇð2], 2)

End If

If ÇáÃÑÞÇã_ÈÚÏ_ÇáÝÇÕáÉ >= 1 Then

ÇáÃÑÞÇã_ÈÚÏ_ÇáÝÇÕáÉ = 0

End If

'ÇáÔÑØ ÇáÊÇáí áÛÑÖ ÚÏã ÇáØÑÍ ÅÐÇ áã íæÌÏ ÃÑÞÇã ÈÚÏ ÇáÝÇÕáÉ

If ÇáÃÑÞÇã_ÈÚÏ_ÇáÝÇÕáÉ < 1 Then

ÇáÑÞã_ÑÞãÇð2 = ÇáÑÞã_ÑÞãÇð2 - ÇáÃÑÞÇã_ÈÚÏ_ÇáÝÇÕáÉ

End If

ÞÑÇÁÉ_Ãæáì = Left([ÇáÑÞã_ÑÞãÇð2], 1)

ÑÞã_Ãæáí = Choose(ÞÑÇÁÉ_Ãæáì, "æÇÍÏ", "ÅËäÇä", "ËáÇËÉ", "ÃÑÈÚÉ", "ÎãÓÉ", "ÓÊÉ", "ÓÈÚÉ", "ËãÇäíÉ", "ÊÓÚÉ")

' ÑÞã æÇÍÏ

If Len([ÇáÑÞã_ÑÞãÇð2]) = 1 Then

' ÊÚÏíá æÇÍÏ ÑíÇá

[ÇáÑÞã_ßÊÇÈÉ2] = ÑÞã_Ãæáí

postscripter · أكتوبر 16, 2013

انصح باستخدام موقع تفقيط الألكتروني www.tafqit.com

تسجيل الدخول

مساعد فى تفقيط الارقام (تفقيط ارقام)

الردود الموصى بها

بوحماد

أيسم إبراهيم

بوحماد

بوحماد

مصطفى كمال

مصطفى كمال

أيسم إبراهيم

مصطفى كمال

أيسم إبراهيم

بوحماد

مصطفى كمال

مصطفى كمال

بوحماد

مصطفى كمال

بوحماد

أيسم إبراهيم

بوحماد

أيسم إبراهيم

بوحماد

مصطفى كمال

بوحماد

مصطفى كمال

وليد المصرى 1

postscripter

Join the conversation

تصفح هذا الموضوع مؤخراً 0 اعضاء متواجدين الان

تصفح الموقع

تصفح جديد الموقع

Support

Important Information