السلام عليكم
هذا الكود والخاص بتحويل الارقام الى حروف فيه خلل بسيط ولكن لم استطيع ايجاده وتعديله لذا اتمنى من يستطيع حل هذا الخلل يفيدني لاني في امس الحاجة له
حيث ان المشكلة في هي مثلا ( 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
