قمت بتضمين دالة التفقيط المعدة من قبل الأخ فراج والموجودة في هذا المنتدى في أحد التقارير في برنامج حسابي يصدر فاتورة. في البداية كانت الدالة تعمل على ما يرام. وتفقط المبلغ الذي أريد بالشكل المطلوب دون أي مشاكل تذكر. لكن في النهاية وجدت أن الدالة تتجاهل الرقم الذي يجب أن يتم تفقيطه ثم تأتي بتفقيط من عندها لا يوجد في أي حقل من حقول الفاتورة. قمت بعمل زر تحديث لبيانات النموذج أقوم بضغط هذا الزر كلما أدخلت بيانات جديدة فأجد أن البيانات في التقرير قد تم تحديثها بالفعل ما عدا خانة التفقيط التي أحيانا تبقى على نفس التفقيط السابق دون أي استفادة من عملية التحديث وأحيانا تأتي لي بتفقيط لرقم غير موجود في الفاتورة أصلا. تأكدت من كون الدالة تستند إلى حقل معروف وهو حقل الصافي النهائي وكانت الإعدادات صحيحة وليس هناك أي خلل برمجي. فما الحل في رأيكم؟؟ البرنامج معمول على أكسس2000 . لكم تحياتي وابتساماتي :D وورودي (f) وهداياي (gift) ودموعي :'( وغموضي :cool: ودهشتي :eek: وعباطتي :P وشيطنتي :mad: وكفى.
مشكلة في التفقيط!!!. هل من حل ؟؟؟.
مغلق
السلام عليكم
ابعت نسخه حتى نشوف المشكله
بركي الداله زعلاني بنرضيها
--------------------------------------؟
Function NoToTxt(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
NoToTxt = "صفر"
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 = Format(TheNo, "000000000000.00")
i = 0
Do While i < 15
If i < 12 Then
MyNo = Mid$(GetNo, i + 1, 3)
Else
MyNo = "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
NoToTxt = ReMark + Mybillion + MyMillion + MyThou + MyHun + " " + MyCur + MyAnd + MyFraction + " " + MySubCur
Else
NoToTxt = ReMark + MyFraction + " " + MySubCur
End If
Else
NoToTxt = ReMark + Mybillion + MyMillion + MyThou + MyHun + " " + MyCur
End If
End Function
-----------------؟
يا أخ أبو سمرة نسأل الله أن يفتح بشرتك أولا.
وثانيا الثلاثة الأسطر الأولى وفهمناها.
الاسترينجات ما فهمناها.
الذي فهمته أن هذه دالة للتفقيط هل هي نفس الدالة التي قام بها الأخ مفرج أم غيرها ؟ كسؤال أول. والسؤال الثاني أعتقد أنه يجب علي أن أقوم بنسخ هذه الدالة ثم ألصقها في مكان ما.. أين ألصقها وكيف أستدعيها في مربع النص الذي يجب أن تتم فيه عملية التفقيط ؟ أرجو التكرم بالرد مشكورا.
السلام عليكم
انسخه كامله في الوحدات النمطيه
----------------------------------------
اعمل اجراء بعد التحديس
انا سميت النص ؟ عمله
----------------------------------------
Private Sub منه_AfterUpdate()
عمله = NoToTxt(منه, "ليره لبنانيه ", "قرش")
End Sub
============
اوكي ان شاء الله تكون استوعبت الموضوع
اخوك ابو محمد
هذا الموضوع مغلق.