07-06-14, 08:21 PM
08-06-14, 09:50 PM
.....
ملاحظة: ليتم نسخ الكود بمحتواه العربي سليماً يجب أن تكون لوحة المفاتيح على اللغة العربية قبل عملية النسخ.
منقول
طريقة استخدام دالة تحويل الرقم إلى نص مع إضافة اسم العملة وإضافة خاصية اختيار الكسر العشري الثلاثي
دالة التحويل بعد تحسينها وإضافة خاصية اختيار الكسر العشري الثلاثي
ضع هذا الكود في موديول Module
.....
ملاحظة: ليتم نسخ الكود بمحتواه العربي سليماً يجب أن تكون لوحة المفاتيح على اللغة العربية قبل عملية النسخ.
منقول
طريقة استخدام دالة تحويل الرقم إلى نص مع إضافة اسم العملة وإضافة خاصية اختيار الكسر العشري الثلاثي
كود :
' عملة بكسر عشري ثنائي كالعملة الأردنية باستخدام القرش حيث يتكون الدينار من 100 قرش
Me.Text2.Text = NoToTxt(Val(Me.Text1.Text), "دينار", "قرش", False)كود :
' عملة بكسر عشري ثلاثي كالعملة الأردنية باستخدام الفلس حيث يتكون الدينار من 1000 فلس
Me.Text2.Text = NoToTxt(Val(Me.Text1.Text), "دينار", "فلس", True)دالة التحويل بعد تحسينها وإضافة خاصية اختيار الكسر العشري الثلاثي
ضع هذا الكود في موديول Module
كود :
Option Explicit
Public Function NoToTxt(ByVal TheNo As Double, ByVal MyCur As String, ByVal MySubCur As String, Optional ByVal Dec3Digit As Boolean = False) As String
'======================
If Dec3Digit Then
If TheNo > 999999999999.999 Then
NoToTxt = ""
Exit Function
End If
Else
If TheNo > 999999999999.99 Then
NoToTxt = ""
Exit Function
End If
End If
'======================
If TheNo = 0 Then
NoToTxt = "صفر"
Exit Function
End If
'======================
Dim MyNo, GetNo, RdNo, GetTxt, ReMark As String
Dim My100, My10, My1, My11, My12 As String
Dim Mybillion, MyMillion As String
Dim MyThou, MyHun, MyFraction As String
Dim MyArry1(9) As String
Dim MyArry2(9) As String
Dim MyArry3(9) As String
Dim MyAnd As String
'======================
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) = "تسعمائة"
'======================
If Dec3Digit Then
GetNo = Format(TheNo, "000000000000.000")
Else
GetNo = Format(TheNo, "000000000000.00")
End If
'======================
Dim i As Integer
For i = 0 To 14 Step 3
If i < 12 Then
MyNo = Mid$(GetNo, i + 1, 3)
Else
If Dec3Digit Then
MyNo = Mid$(GetNo, i + 2, 3)
Else
MyNo = "0" + Mid$(GetNo, i + 2, 3)
End If
End If
If (Mid$(MyNo, 1, 3)) > 0 Then
RdNo = Mid$(MyNo, 1, 1)
My100 = MyArry3(RdNo)
RdNo = Mid$(MyNo, 3, 1)
My1 = MyArry1(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
Next
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.....
10-06-14, 01:20 AM
السلام عليكم
لم تنجح معي ممكن مثال اخي ..بارك الله فيك
لم تنجح معي ممكن مثال اخي ..بارك الله فيك
10-06-14, 12:01 PM
(10-06-14, 01:20 AM)princeofislam كتب : [ -> ]السلام عليكم
لم تنجح معي ممكن مثال اخي ..بارك الله فيك
السلام عليكم
البرنامج رائع ويعمل ما هو مطلوب وارفق مثال على ذلك
يعطيكم العافية
15-08-14, 10:21 PM
بارك الله بك يا اخي ابو الليث انا اسف ما كنت اون لاين كنت مريضا ..
الله يسعدك و ريح بالك اخي ..اللهم امين واحلى منتدى في العالم
الله يسعدك و ريح بالك اخي ..اللهم امين واحلى منتدى في العالم
31-03-15, 12:18 AM
بارك الله فيك يا أخي وجعلة فى ميزان حسناتك
16-11-15, 01:45 AM
لدي برنامج تفقيط وهو على نظام القروش ( كسر العشر الثنائي ) لكن اريده على نظام كسر العشر الثلاثي
ارجوا المساعده
ارجوا المساعده
(07-06-14, 08:21 PM)princeofislam كتب : [ -> ]السلام عليكم ورحمة الله و بركاتة
احتاح لبرنامج التفقيط و طباعة الشيكات بالعملة الاردنية ان امكن ..وجزاكم الله خيرا يا ربي
16-11-15, 01:55 AM
السلام عليكم
اخي الكريم انظر الى المثال الموجود في هذا الموضوع انه تفقط لثلاث منازل عشرية
او ارفق المثال الموجود لديك لكي يتم التعديل عليه
حياك الله
اخي الكريم انظر الى المثال الموجود في هذا الموضوع انه تفقط لثلاث منازل عشرية
او ارفق المثال الموجود لديك لكي يتم التعديل عليه
حياك الله