اريد كود تحويل المبلغ في الفاتورة الى نص

اهلا اخي الكريم

تفضل

ضع هذا الكود في وحدة نمطية جديدة

اقتباس

Public Declare Function GetSystemMenu Lib "user32" (ByVal hwnd As Long, ByVal bRevert As Long) As Long

Public Declare Function RemoveMenu Lib "user32" (ByVal hMenu As Long, ByVal nPosition As Long, ByVal wFlags As Long) As Long

Public Const MF_BYPOSITION = &H400&

Public Function Horof(X)

Ma = " ÑíÇá"

Mi = " åááÉ"

N = Int(X)

b = Val(Right(Format(X, "000000000000.00"), 2))

R = SHorof(N)

If R <> "" And b > 0 Then Result = R & Ma & " æ " & b & Mi

If R <> "" And b = 0 Then Result = R & Ma

If R = "" And b <> 0 Then Result = b & Mi

Horof = Result

End Function

Private Function SHorof(X)

N = Int(X)

C = Format(N, "000000000000")

C1 = Val(Mid(C, 12, 1))

Select Case C1

Case Is = 1: Letter1 = "æÇÍÏ"

Case Is = 2: Letter1 = "ÇËäÇä"

Case Is = 3: Letter1 = "ËáÇËÉ"

Case Is = 4: Letter1 = "ÇÑÈÚÉ"

Case Is = 5: Letter1 = "ÎãÓÉ"

Case Is = 6: Letter1 = "ÓÊÉ"

Case Is = 7: Letter1 = "ÓÈÚÉ"

Case Is = 8: Letter1 = "ËãÇäíÉ"

Case Is = 9: Letter1 = "ÊÓÚÉ"

End Select

C2 = Val(Mid(C, 11, 1))

Select Case C2

Case Is = 1: Letter2 = "ÚÔÑ"

Case Is = 2: Letter2 = "ÚÔÑæä"

Case Is = 3: Letter2 = "臂辊"

Case Is = 4: Letter2 = "ÇÑÈÚæä"

Case Is = 5: Letter2 = "ÎãÓæä"

Case Is = 6: Letter2 = "ÓÊæä"

Case Is = 7: Letter2 = "ÓÈÚæä"

Case Is = 8: Letter2 = "ËãÇäæä"

Case Is = 9: Letter2 = "ÊÓÚæä"

End Select

If Letter1 <> "" And C2 > 1 Then Letter2 = Letter1 + " æ" + Letter2

If Letter2 = "" Then Letter2 = Letter1

If C1 = 0 And C2 = 1 Then Letter2 = Letter2 + "É"

If C1 = 1 And C2 = 1 Then Letter2 = "ÇÍÏì ÚÔÑ"

If C1 = 2 And C2 = 1 Then Letter2 = "ÇËäì ÚÔÑ"

If C1 > 2 And C2 = 1 Then Letter2 = Letter1 + " " + Letter2

C3 = Val(Mid(C, 10, 1))

Select Case C3

Case Is = 1: Letter3 = "ãÇÆÉ"

  Case Is = 2: Letter3 = "ãÆÊÇä"

Case Is > 2: Letter3 = Left(SHorof(C3), Len(SHorof(C3)) - 1) + "ãÇÆÉ"

End Select

If Letter3 <> "" And Letter2 <> "" Then Letter3 = Letter3 + " æ" + Letter2

If Letter3 = "" Then Letter3 = Letter2

C4 = Val(Mid(C, 7, 3))

Select Case C4

Case Is = 1: Letter4 = "ÇáÝ"

Case Is = 2: Letter4 = "ÇáÝÇä"

Case 3 To 10: Letter4 = SHorof(C4) + " ÂáÇÝ"

Case Is > 10: Letter4 = SHorof(C4) + " ÇáÝ"

End Select

If Letter4 <> "" And Letter3 <> "" Then Letter4 = Letter4 + " æ" + Letter3

If Letter4 = "" Then Letter4 = Letter3

C5 = Val(Mid(C, 4, 3))

Select Case C5

  Case Is = 1: Letter5 = "ãáíæä"

  Case Is = 2: Letter5 = "ãáíæäÇä"

  Case 3 To 10: Letter5 = SHorof(C5) + " ãáÇííä"

  Case Is > 10: Letter5 = SHorof(C5) + " ãáíæä"

  End Select

  If Letter5 <> "" And Letter4 <> "" Then Letter5 = Letter5 + " æ" + Letter4

  If Letter5 = "" Then Letter5 = Letter4

  C6 = Val(Mid(C, 1, 3))

  Select Case C6

  Case Is = 1: Letter6 = "ãáíÇÑ"

  Case Is = 2: Letter6 = "ãáíÇÑÇä"

  Case Is > 2: Letter6 = SHorof(C6) + " ãáíÇÑ"

End Select

If Letter6 <> "" And Letter5 <> "" Then Letter6 = Letter6 + " æ" + Letter5

If Letter6 = "" Then Letter6 = Letter5

SHorof = Letter6

End Function

وفي النموذج ضع هذا الكود الذي يستدعي الدالة الاولى ويمرر لها الرقم مثال ( 2500 )

والنتيجة تظهر في مربع النص الذي اسميتة text1.text

Dim strn As String
strn = Horof(Me.ss)
text1.text= strn

تحياتي

عاشق البيسك :rolleyes:

الف الف شكر اخوي عاشق البيسيك والله ما قصرت

ان شاء الله اليوم راح اجرب الكود

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

Case Is = 1: Letter1 = "æÇÍÏ

المهم قمت باستبدال "&aelig;ÇÍÏ" بكلمة "واحد" كذلك البقية "اثنان ، ثلاثة ،...، مئة ، الف،.."

وضبط معي الكود

بس حبيت اعرف عن الرموز :blink: وش تقصد فيها

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

وعلى العمووووووووووم

الفففففففففففففففففففففففف شكر على الكود وعلى مساعدتك لي :)