التفقيط للعملة الكويتية

السلام عليكم..

نعم يا اخي.. انا مثلك ... اين الخبراء لكي يجيبوا علينا يا شباب؟؟

محتاجين الجواب ضروري؟؟

:confused: :'( :confused: :'(

و لكن نرجو اختيار دالة من الدوال الموجودة فى الأرشيف

لكي نحولها ( صعب نحولهم كلهم )

أخبرنا أي دالة تريد ( من موضوع 12 دالة للتفقيط )

السلام عليكم...

يا اخي جزاك الله خير..

اختار احسن وحدة وتؤدي الواجب

انا اريد ان احول المبلغ في الفاتورة او التقرير المحاسبي مثلاً الى ارقام

ثلاث خانات

فلس و دينار كويتي

استخدم اكسس 97 او 2000

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

:o :eek:

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

no = Round(no, 3)

و استبدل كلمة جنيه بدينار و كلمة قرش بفلس

لقد جربت ذلك مع الدالة رقم 3 ( الخاصة بطارق حنيدق و نجحت المخاولة)

و أعتقد ان ذلك يصلح لمعظم دوال التفقيط

الأخ / محمد طاهر

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

وفقكم الله

وضعت ردا و مسحته

لأني و جدت به خطأ و سأضع الكود الجديد باذن الله قريبا

السلام عليكم...

شكراً لكم وخاصة الاخ محمد طاهر

باسرع وقت ممكن الصراحة انا بحاجة الى هذا الكود لكي اسلم مشروعي..

انا بانتظارك على احر من الجمر؟؟!!!

:confused: :'(

صادفتني مشاكل مع دالة طارق

فحولت دالة أبو هاني

أرجو أن يكون هذا هو الطلوب

Function NoToTxt2(TheNo As Double, MyCur As String, MySubCur As String) As String
Dim MyArry1(0 To 9) 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.99 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 < 15

If I < 12 Then
Myno = Mid$(GetNo, I + 1, 3)
Else
Myno = Mid$(GetNo, I + 2, 2) + "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

السلام عليكم..

شكرا وجزاك الله خير..

الصراحة لم اجرب هذه الدالة لسبب بسيط

لا اعرف اين اضعها

فاين اضعها ... هذا اولاُ

وثانيا كيف اضع خانة للفلس وخانة للدينار كل على حدة؟!!

والله يجزيكم كل الخير

وشكراً

تضعها فى موديول جديد

و تستدعيها كما يلي

=NoToTxt2([textboxname];"دينار";"فلس")
او فى حالة الفورم
=NoToTxt2(Me.textboxname;"دينار";"فلس")

أما عن السؤال الخص بفصل القيمة الي جزئين فاجابته مع السؤال

http://www.arabteam2000.com/vb/showthread....&threadid=12143

السلام عليكم...

يا اخي الله يخليك ويطول عمرك باعمال الخير

لو تضع هذا الكود التفقيط بالعملة الكويتية ثلاث خانات في مثال

انا الظاهر مستعجل او في شي غلط بالكود

انت فنان وخبير وان شاء الله ما تاخذ وقت منك

انا بانتظار المثال على احر من الجمر

حتى تقسيم المبلغ الى خانتين فلس ودينار لم تنجح

الرجاء ارساله على بريدي لانه يمكن الرابط احيانا ما يشتغل

hatemflbn@hotmail.com

ارجوك وان شاء الله في ميزان حسناتك

:( :(

الاخ العزيز / محمد طاهر

أولا شكرا لك لما تقدمه من جهد لهذا المنتدى

ثانيا : دالة التفقيط التي تم تعديلها لتلائم العملة الكويتية لم تؤد الغرض المطلوب ، ولتأكيد ذلك حاول ادخال رقم في خانة آحاد الفلوس غير الصفر مثال ( 150.255 )

وفقك الله

بالفعل الدالة بعد التعديل تتجاهل آخر رقم (الآحاد )

سأحاول ثانية

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

تم عمل تعديل مؤقت فى الدالة

أبو حمود 2 كي لا تتوقف عند ادخال 3 أرقام عشرية

و التعديل المؤقت لايقافها فقط

و تم تحديث الملف

فى الدالة أبو حمود 2
في البداية
Public Sub تحويل_الرقم_كتابة2()
On Error GoTo Myerror

و قبل النهاية مباشرة
Exit Sub
Myerror:
الرقم_كتابة2 = "--"
End Sub

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

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

عموما سنصل الي ما تريدون قريبا باذن الله ، بمشاركة الاخوة

و اذا فقدت الامل فى تعديل دالة منهم الي ما تريد ، فسأبدأ كتابة دالة من البداية أسهل ، حيث أن فهم دوال الغير شيئ صعب شوية

و عندنا مثل بيقول : كل شيخ و له طريقة

ان لم أكن مخطئا فقد تم تعديل الدالتين

أعد التنزيل و أخبرني بالنتيجة

شكرا لك أخي محمد على هذا المجهود والعطاء الرائع

السلام عليكم...

اخي محمد طاهر...

الكود تمام في اكسس 2000

لكن اكسس 97 لم يعمل... وخاصة دالة Round

وانا الصراحة لازم اسلم برنامجي الى العميل باقصى سرعة ولكن تنقصه هذه الدالة (الملعون)... وبرنامجي كبير جداً... وسالت سؤال من قبل بخصوص تحويل اكسس 97 الى اكسس 2000 مع ظهور رسائل اخطاء كثيرة تحول دون اتمام عملية التحويل ولم القى الجواب الشافي؟؟

المهم يا اخ محمد طاهر ارجوك وندعو لك اتمام هذا الكود (تفقيط عملة كويتية 3 خانات) باقصى سرعة سرعة سرعة ممكنة لو سمحت؟؟!

انا على احر من الجمر

:mad: :'(

:mad:

ليس لدي 97

و الكود الموجود فى المثال جربته مع 2000 و اكس بي

و يعمل بنجاح علي تفقيط ال 3 خانات

أما 97 فهو غير متاح بالنسبة لي حاليا

و لكن أيضا راجع المراجع و خاصة ado

إن أردت أرسل لي المثال لأحوله الي 2000