• 0
man_2011

أرجو التكرم بتعديل الخلل في الكود المرفق !

سؤال

السلام عليكم

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

حيث ان المشكلة في هي مثلا ( 40.450 ) تكتب أربعون دينار و 45 فلس وليس 450 فلس

حيث لو كتبت الرقم (40.400) تكتب بشكل صحيح أربعون دينار و 400 فلس ولا توجد مشكلة

لا اعلم ما الحل واين الخلل .

Function Wrdx(T As String)

Dim i As Integer

Dim j As Integer

Dim Wrd As String

Dim wrd1 As String

Dim wrd2 As String

Dim wrd3 As String

Dim wrd4 As String

Dim a(10) As String

Dim aa(10) As String

Dim sHund As String

Wrd = ""

wrd1 = ""

wrd2 = ""

wrd3 = ""

wrd4 = ""

a(1) = "واحد "

a(2) = "اثنين "

a(3) = "ثلاثة "

a(4) = "اربعة "

a(5) = "خمسة "

a(6) = "ستة "

a(7) = "سبعة "

a(8) = "ثمانية "

a(9) = "تسعة "

aa(1) = "عشر "

aa(2) = "عشرون "

aa(3) = "ثلاثون "

aa(4) = "اربعون "

aa(5) = "خمسون "

aa(6) = "ستون "

aa(7) = "سبعون "

aa(8) = "ثمانون "

aa(9) = "تسعون "

On Error Resume Next

If InStr(T, ".") > 0 Then

j = InStr(T, ".")

wrd4 = Mid(T, j + 1, 3)

If Len(wrd4) = 1 Then

wrd4 = wrd4 & "00"

End If

T = Mid(T, 1, j - 1)

End If

i = Len(T)

Select Case i

Case 1

Wrd = a(Val(T))

Case 2

If Val(T) = 10 Then

Wrd = "عشرة "

ElseIf Val(T) = 11 Then

Wrd = "احدعشر "

ElseIf Val(T) = 12 Then

Wrd = "اثناعشر "

ElseIf Val(T) < 20 Then

Wrd = a(Val(Right(T, 1))) & aa(Val(Left(T, 1)))

ElseIf Val(Right(T, 1)) = 0 Then

Wrd = aa(Val(Left(T, 1)))

Else

Wrd = a(Val(Right(T, 1))) & "و" & aa(Val(Left(T, 1)))

End If

Case 3

If Val(Mid(T, 1, 1)) = 1 Then

wrd1 = "مائة "

ElseIf Val(Mid(T, 1, 1)) = 2 Then

wrd1 = "مائتين "

Else

sHund = a(Val(Mid(T, 1, 1)))

If Val(Mid(T, 1, 1)) = 8 Then

sHund = Left(sHund, Len(sHund) - 3)

Else

sHund = Left(sHund, Len(sHund) - 2)

End If

wrd1 = sHund & "مائة" & " "

End If

T = Mid(T, 2, 2)

If Val(T) = 10 Then

Wrd = "عشرة "

ElseIf Val(T) = 11 Then

Wrd = "احدعشر "

ElseIf Val(T) = 12 Then

Wrd = "اثناعشر "

ElseIf Val(T) < 20 Then

Wrd = a(Val(Right(T, 1))) & aa(Val(Left(T, 1)))

ElseIf Val(Right(T, 1)) = 0 Then

Wrd = aa(Val(Left(T, 1)))

Else

Wrd = a(Val(Right(T, 1))) & "و" & aa(Val(Left(T, 1)))

End If

If Wrd = "" Then

Wrd = wrd1

Else

Wrd = wrd1 & "و" & Wrd

End If

Case 4

If Val(Mid(T, 1, 1)) = 1 Then

wrd2 = "الف "

ElseIf Val(Mid(T, 1, 1)) = 2 Then

wrd2 = "الفين "

Else

wrd2 = a(Val(Mid(T, 1, 1))) & "الاف "

End If

T = Mid(T, 2, 3)

If Val(Mid(T, 1, 1)) = 1 Then

wrd1 = "مائة "

ElseIf Val(Mid(T, 1, 1)) = 2 Then

wrd1 = "مائتين "

Else

If Mid(T, 1, 1) > "0" Then

If Val(Mid(T, 1, 1)) = 1 Then

wrd1 = "مائة "

ElseIf Val(Mid(T, 1, 1)) = 2 Then

wrd1 = "مائتين "

Else

sHund = a(Val(Mid(T, 1, 1)))

If Val(Mid(T, 1, 1)) = 8 Then

sHund = Left(sHund, Len(sHund) - 3)

Else

sHund = Left(sHund, Len(sHund) - 2)

End If

wrd1 = sHund & "مائة" & " "

End If

End If

End If

T = Mid(T, 2, 2)

If Val(T) = 10 Then

Wrd = "عشرة "

ElseIf Val(T) = 11 Then

Wrd = "احدعشر "

ElseIf Val(T) = 12 Then

Wrd = "اثناعشر "

ElseIf Val(T) < 20 Then

Wrd = a(Val(Right(T, 1))) & aa(Val(Left(T, 1)))

ElseIf Val(Right(T, 1)) = 0 Then

Wrd = aa(Val(Left(T, 1)))

Else

Wrd = a(Val(Right(T, 1))) & "و" & aa(Val(Left(T, 1)))

End If

If wrd1 <> "" Then

wrd1 = "و" & wrd1

End If

If Wrd <> "" Then

Wrd = "و" & Wrd

End If

Wrd = wrd2 & wrd1 & Wrd

Case 5

If Val(Mid(T, 1, 2)) = 10 Then

wrd2 = "عشرة الاف "

ElseIf Val(Mid(T, 1, 2)) = 11 Then

wrd2 = "احدعشرالفا "

ElseIf Val(Mid(T, 1, 2)) = 12 Then

wrd2 = "اثناعشرالفا "

ElseIf Val(Mid(T, 1, 2)) < 20 Then

wrd2 = a(Val(Mid(T, 2, 1))) & aa(Val(Mid(T, 1, 1))) & "الفا "

ElseIf Val(Mid(T, 2, 1)) = 0 Then

wrd2 = aa(Val(Mid(T, 1, 1))) & "الفا "

Else

wrd2 = a(Val(Mid(T, 2, 1))) & "و" & aa(Val(Mid(T, 1, 1))) & "الفا "

End If

T = Mid(T, 3, 3)

If Val(Mid(T, 1, 1)) = 1 Then

wrd1 = "مائة "

ElseIf Val(Mid(T, 1, 1)) = 2 Then

wrd1 = "مائتين "

Else

If Mid(T, 1, 1) = "0" Then

wrd1 = a(Val(Mid(T, 1, 1)))

Else

sHund = a(Val(Mid(T, 1, 1)))

If Val(Mid(T, 1, 1)) = 8 Then

sHund = Left(sHund, Len(sHund) - 3)

Else

sHund = Left(sHund, Len(sHund) - 2)

End If

wrd1 = sHund & "مائة" & " "

End If

End If

T = Mid(T, 2, 2)

If Val(T) = 10 Then

Wrd = "عشرة "

ElseIf Val(T) = 11 Then

Wrd = "احدعشر "

ElseIf Val(T) = 12 Then

Wrd = "اثناعشر "

ElseIf Val(T) < 20 Then

Wrd = a(Val(Right(T, 1))) & aa(Val(Left(T, 1)))

ElseIf Val(Right(T, 1)) = 0 Then

Wrd = aa(Val(Left(T, 1)))

Else

Wrd = a(Val(Right(T, 1))) & "و" & aa(Val(Left(T, 1)))

End If

If wrd1 <> "" Then

wrd1 = "و" & wrd1

End If

If Wrd <> "" Then

Wrd = "و" & Wrd

End If

Wrd = wrd2 & wrd1 & Wrd

Case 6

If Val(Mid(T, 1, 1)) = 1 Then

wrd3 = "مائة "

ElseIf Val(Mid(T, 1, 1)) = 2 Then

wrd3 = "مائتي "

Else

wrd3 = a(Val(Mid(T, 1, 1))) & "مائة "

End If

T = Mid(T, 2, 5)

If Val(Mid(T, 1, 2)) = 10 Then

wrd2 = "عشرة الاف "

ElseIf Val(Mid(T, 1, 2)) = 11 Then

wrd2 = "احدعشرالفا "

ElseIf Val(Mid(T, 1, 2)) = 12 Then

wrd2 = "اثناعشرالفا "

ElseIf Val(Mid(T, 1, 2)) < 20 Then

wrd2 = a(Val(Mid(T, 2, 1))) & aa(Val(Mid(T, 1, 1))) & "الفا "

ElseIf Val(Mid(T, 2, 1)) = 0 Then

wrd2 = aa(Val(Mid(T, 1, 1))) & "الفا "

Else

wrd2 = a(Val(Mid(T, 2, 1))) & "و" & aa(Val(Mid(T, 1, 1))) & "الفا "

End If

T = Mid(T, 3, 3)

If Val(Mid(T, 1, 1)) = 1 Then

wrd1 = "مائة "

ElseIf Val(Mid(T, 1, 1)) = 2 Then

wrd1 = "مائتين "

Else

If Mid(T, 1, 1) = "0" Then

wrd1 = a(Val(Mid(T, 1, 1)))

Else

sHund = a(Val(Mid(T, 1, 1)))

If Val(Mid(T, 1, 1)) = 8 Then

sHund = Left(sHund, Len(sHund) - 3)

Else

sHund = Left(sHund, Len(sHund) - 2)

End If

wrd1 = sHund & "مائة" & " "

End If

End If

T = Mid(T, 2, 2)

If Val(T) = 10 Then

Wrd = "عشرة "

ElseIf Val(T) = 11 Then

Wrd = "احدعشر "

ElseIf Val(T) = 12 Then

Wrd = "اثناعشر "

ElseIf Val(T) < 20 Then

Wrd = a(Val(Right(T, 1))) & aa(Val(Left(T, 1)))

ElseIf Val(Right(T, 1)) = 0 Then

Wrd = aa(Val(Left(T, 1)))

Else

Wrd = a(Val(Right(T, 1))) & "و" & aa(Val(Left(T, 1)))

End If

If wrd1 <> "" Then

wrd1 = "و" & wrd1

End If

If Wrd <> "" Then

Wrd = "و" & Wrd

End If

If wrd2 <> "الفا " Then

wrd2 = "و" & wrd2

End If

Wrd = wrd3 & wrd2 & wrd1 & Wrd

End Select

If wrd4 = "" Then

Wrdx = Wrd & "دينار"

Else

Wrdx = Wrd & " دينار و " & wrd4 & " فلس "

End If

End Function

0

شارك هذا الرد


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

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

  • 0

اخي مان ضع المرفق الخاص بك وان شاء الله تنحل

0

شارك هذا الرد


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

أخى أخبرنا ما هو الخلل الذى تواجهة .. أو صورة منه على الأقل ..

أو يمكنك استخدام داله أخينا أبو هادى بالمرفق وتعديل الجنيهات إلى دينارات.

تحياتى

محمد ندا

NumToText Module.rar

0

شارك هذا الرد


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

العين ماتعلى ع الحاجب اخوي محمد واسمح لي ان اضيف هذا الملف

اخوي مان انظر للمرفق لعل وعسى ان يكون هو مطلوبك وجزاء الله خير على من قام بتصميمه

post-250813-009408600 1322938832_thumb.p

فاتورة مبيعات التفقيط بالدينار الكويتي.zip

0

شارك هذا الرد


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

أخى فهد مرحباً بك.

وبارك الله فيك ،، أرجو أن يكون بالمرفق طلب أخينا مان .. فأنا كنت مقصراً عندما أرفقت له ملفاً بتفقيط مصرى.

أشكرك على الدعم.

تحياتى

محمد ندا

0

شارك هذا الرد


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

شكراً لكم كثيراً الأخ فهد والأخ محمد

لكن اتمنى التطبيق على المثال المرفق ولكم جزيل الشكر

New.rar

0

شارك هذا الرد


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

تفضل اخي الكريم

ملفك بعد التعديل بناء على طلبك

post-15367-055245200 1323242648_thumb.gi

za-New.rar

بالتوفيق

0

شارك هذا الرد


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

تفضل اخي الكريم

ملفك بعد التعديل بناء على طلبك

post-15367-055245200 1323242648_thumb.gi

za-New.rar

بالتوفيق

شكرا الغالية زهراء

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

40.750 يكتب بالطريقة التالية ( أربعون دينار و 75 فلس بدون الصفر )

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

0

شارك هذا الرد


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

شكرا الغالية زهراء

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

40.750 يكتب بالطريقة التالية ( أربعون دينار و 75 فلس بدون الصفر )

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

ما اضيف للبرنامج فقط هو تحويل أرقام الأفلاس إلى حروف أيضا

كما هو موضح في مثالك المرفق

ولكن المشكلة لم تحل أيضا

بإمكانك التجربة

40.750 يكتب ( أربعون دينار وخمسة وسبعون فلس ) وليس سبعمائة وخمسون فلس

0

شارك هذا الرد


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

تفضل اخي الكريم

ملفك بعد التعديل بناء على طلبك

post-15367-002321800 1323254682_thumb.gi

za-New-UP.rar

بالتوفيق

0

شارك هذا الرد


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

تفضل اخي الكريم

ملفك بعد التعديل بناء على طلبك

post-15367-002321800 1323254682_thumb.gi

za-New-UP.rar

بالتوفيق

شكراَ لك كثيراَ الأخت زهراء

هذا هو المطلوب فعلا

يعجز اللسان عن شكرك

0

شارك هذا الرد


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

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

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



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

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

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