• 0
medino55

طلب كود تحويل الارقام الى حروف

سؤال

السلام عليكم

اريد من فضلكم كود تحويل الارقام الى حروف و شكرا جزيلا لكم

0

شارك هذا الرد


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

11 إجابة على هذا السؤال .

  • 0

chr(رمز الحرف)

0

شارك هذا الرد


رابط المشاركة
شارك الرد من خلال المواقع ادناه
  • 0

اخي اذا كان قصدك تحويل الارقام الى حروف ، اي التفقيط ، فرجاء كتابة كلمة تفقيط في مربع البحث في اسفل هذه الصفحة ، وستحصل على العديد من المواضيع ذات الصلة :)

 

جعفر

0

شارك هذا الرد


رابط المشاركة
شارك الرد من خلال المواقع ادناه
  • 0

ارجوا ان اكون قد افتكم بهذا الرد 

Function NoToTxt2(TheNo As Double, MyCur As String, MySubCur As String) 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 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 > 1500 Then Exit Function

If TheNo < 0 Then

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 < 16

 

If I < 12 Then

Myno = Mid$(GetNo, I + 1, 3)

Else

Myno = Mid$(GetNo, I + 2, 3) + "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 = 6) And (GetTxt <> "") Then

If ((Mid$(Myno, 1, 3)) > 10) Then

MyThou = GetTxt + " الف"

Else

MyThou = GetTxt + " الاف"

If ((Mid$(Myno, 3, 1)) = 1) 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 (MyThou <> "") Then

If (MyHun <> "") Then MyThou = MyThou + MyAnd

End If

End Function

0

شارك هذا الرد


رابط المشاركة
شارك الرد من خلال المواقع ادناه
  • 0

السلام عليكم

الاستاذ محمد الشاهلي

 

ممكن ارفاق قاعدة بيانات تحتوى على مثال لكود التفقيط؟

 

تحياااتي

0

شارك هذا الرد


رابط المشاركة
شارك الرد من خلال المواقع ادناه
  • 0

لقد عانيت الكثير سابقا من تحول الاسماء والحروف العربية في الكود الى حروف اغريقية او علامات استفهام :(

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

 

لحل هذه الانواع من المشاكل ، فإني اضع هذه المسميات العربية في جدول ، ثم اطلبها عن الطريق الكود وقتما شئت ، وبهذا اتفادى كتابتها في الكود :)

وعندما اعمل رسالئل تنبيه في برنامجي ، فإني كذلك احفظ الكلمات العربية في الجدول ، ثم اطلبها عن الطريق الكود وقتما شئت :)

 

جعفر

0

شارك هذا الرد


رابط المشاركة
شارك الرد من خلال المواقع ادناه
  • 0

ارجوا ان اكون قد افتكم بهذا الرد 

Function NoToTxt2(TheNo As Double, MyCur As String, MySubCur As String) 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 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 > 1500 Then Exit Function

If TheNo < 0 Then

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 < 16

 

If I < 12 Then

Myno = Mid$(GetNo, I + 1, 3)

Else

Myno = Mid$(GetNo, I + 2, 3) + "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 = 6) And (GetTxt <> "") Then

If ((Mid$(Myno, 1, 3)) > 10) Then

MyThou = GetTxt + " الف"

Else

MyThou = GetTxt + " الاف"

If ((Mid$(Myno, 3, 1)) = 1) 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 (MyThou <> "") Then

If (MyHun <> "") Then MyThou = MyThou + MyAnd

End If

End Function

برجاء توضيح لى كيفية اضافة الكود ليظهر فى التقرير الخاص بأذن الصرف ولك جزيل الشكر 

0

شارك هذا الرد


رابط المشاركة
شارك الرد من خلال المواقع ادناه
  • 0

اخى العزيز قم باختيار تذييل التقرير ثم ضع الكود فى حدث عند الطباعة كالمرفق 

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

post-199787-0-40800600-1378848370_thumb.

post-199787-0-69601500-1378848415_thumb.

post-199787-0-24903500-1378848451_thumb.

0

شارك هذا الرد


رابط المشاركة
شارك الرد من خلال المواقع ادناه
  • 0

لاحظ ظهور التفقيط عند معاينة الطباعة

كما بالمرفقات 

Database1.rar

تم تعديل بواسطه ابوجمانة2009
0

شارك هذا الرد


رابط المشاركة
شارك الرد من خلال المواقع ادناه
  • 0

اخي الغالي عندي لك طررريقه تفيدك ان شاء الله وهي سهلة جداً 

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

post-276708-0-47672900-1378886626_thumb.

post-276708-0-66163600-1378886637_thumb.

post-276708-0-32064000-1378886644_thumb.

post-276708-0-83819500-1378886651_thumb.

moner.rar

0

شارك هذا الرد


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

من فضلك سجل دخول لتتمكن من التعليق

ستتمكن من اضافه تعليقات بعد التسجيل



سجل دخولك الان

  • يستعرض القسم حالياً   0 members

    لا يوجد أعضاء مسجلين يشاهدون هذه الصفحة .