كيفية تحويل الارقام الى حروف باللغة العربية

[hesham]

[hesham]

كيفية تحويل الارقام الى حروف باللغة العربية

[Abdul]

Option Explicit

'****************
' Main Function *
'****************
Const An As String = " æ "
Const Ab As String = " ÝÞÜØ"

Function SpellA(ByVal myNumber As String)

Dim intPound, intPiaster, Temp
Dim DecimalPlace, Count
Dim S As String

Dim Place(9, 3) As String
Place(2, 1) = " ÃáÝ "
Place(2, 2) = " ÃáÝíä "
Place(2, 3) = " ÂáÇÝ "

Place(3, 1) = " ãáíæä "
Place(3, 2) = " ãáíæäíä "
Place(3, 3) = " ãáÇííä "

Place(4, 1) = " Èáíæä "
Place(4, 2) = " Èáíæäíä "
Place(4, 3) = " ÈáÇííä "

Place(5, 1) = " ÊÑíáíæä "
Place(5, 2) = " ÊÑíáíæä "
Place(5, 3) = " ÊÑíáíæä "

' String representation of amount
' myNumber = Convert.ToString(myNumber)
myNumber = Trim(Str(myNumber))

' Position of decimal place 0 if næÇÍÏ
DecimalPlace = InStr(myNumber, ".")
'Convert intPiaster æ set MyNumber to Ìäíå amount
If DecimalPlace > 0 Then
intPiaster = Left(Mid(myNumber, DecimalPlace + 1) & _
"00", 2)
myNumber = Trim(Left(myNumber, DecimalPlace - 1))
' intPiaster = GetTens(Left(Mid(myNumber, DecimalPlace + 1) &
"00", 2))
' myNumber = Trim(Left(myNumber, DecimalPlace - 1))
End If

Count = 1
Do While myNumber <> ""
Temp = GetHundreds(Right(myNumber, 3))
' Dim S As String = Right(MyNumber, 3)
S = Right(myNumber, 3)
If Count = 1 Then
If Temp <> "" Then intPound = Temp & Place(Count, GetIndex(S))
& intPound
Else
If Val(Right(myNumber, 3)) <= 2 Then
If Temp <> "" Then intPound = Place(Count, GetIndex(S)) & An
& intPound
Else
If Temp <> "" Then intPound = Temp & Place(Count,
GetIndex(S)) & An & intPound
End If
End If
If Len(myNumber) > 3 Then
myNumber = Left(myNumber, Len(myNumber) - 3)
Else
myNumber = ""
End If
Count = Count + 1
Loop
If Right(intPound, 3) = An Then
intPound = Left(intPound, Len(intPound) - 3)
End If
Select Case intPound
Case ""
intPound = "ÕÝÑ"
'intPound = "ÕÝÑ ÌäíåÇð"
Case "æÇÍÏ"
intPound = "æÇÍÏ "
' intPound = "Ìäíå æÇÍÏ"

Case "ÇËäíä"
'intPound = "ÌäíåÇä"
intPound = "ÇËäíä "
Case "ËáÇËÉ"
'intPound = "ËáÇËÉ ÌäíåÇÊ"
intPound = "ËáÇËÉ "
Case "ÇÑÈÚÉ"
' intPound = "ÇÑÈÚÉ ÌäíåÇÊ"
intPound = "ÇÑÈÚÉ "
Case "ÎãÓÉ"
intPound = "ÎãÓÉ "
' intPound = "ÎãÓÉ ÌäíåÇÊ"

Case "ÓÊÉ"
intPound = "ÓÊÉ "
'intPound = "ÓÊÉ ÌäíåÇÊ"
Case "ÓÈÚÉ "
' intPound = "ÓÈÚÉ ÌäíåÇÊ"
intPound = "ÓÈÚÉ "
Case "ËãÇäíÉ"
'intPound = "ËãÇäíÉ ÌäíåÇÊ"
intPound = "ËãÇäíÉ "
Case "ÊÓÚÉ"
intPound = "ÊÓÚÉ "
'intPound = "ÊÓÚÉ ÌäíåÇÊ"
Case "ÚÔÑÉ"
intPound = "ÚÔÑÉ "
' intPound = "ÚÔÑÉ ÌäíåÇÊ"

Case Else
' intPound = intPound & " ÌäíåÇð"
intPound = intPound & " "
End Select

Select Case intPiaster
Case ""
intPiaster = "æ 100/00"
' ' Cents = Application.NumberFormat(Cents,
"[$-2000000]#0")
Case "æÇÍÏ"
' 'Cents = " and One Cent"
intPiaster = "æ 100/01"
' ' Cents = Application.NumberFormat(Cents,
"[$-2000000]#0")
Case Else
' ' Cents = " and " & Cents & " Cents"
intPiaster = " æ " & "100/" & intPiaster

' ' Cents = Application.NumberFormat(Cents,
"[$-2000000]#0")
End Select
'

SpellA = intPound & intPiaster
' SpellA.NumberFormat = "[$-2000000]#0.00"
End Function

'*******************************************
' Converts a number from 100-999 into text *
'*******************************************

Function GetHundreds(ByVal myNumber As String)
Dim Result As String
Dim T As String

If Val(myNumber) = 0 Then Exit Function
myNumber = Right("000" & myNumber, 3)

'Convert the hundreds place
If Mid(myNumber, 1, 1) <> "0" Then

T = GetDigit(Mid(myNumber, 1, 1))
If T = "æÇÍÏ" Then
Result = " ãÆÉ "

ElseIf T = "ÇËäíä" Then
Result = " ãÆÊÇ "

ElseIf T = "ËáÇËÉ" Then
Result = " ËáÇËãÇÆÉ "

ElseIf T = "ÇÑÈÚÉ" Then
Result = " ÇÑÈÚãÇÆÉ "

ElseIf T = "ÎãÓÉ" Then
Result = " ÎãÓãÇÆÉ "

ElseIf T = "ÓÊÉ" Then
Result = " ÓÊãÇÆÉ "

ElseIf T = "ÓÈÚÉ" Then
Result = " ÓÈÚãÇÆÉ "

ElseIf T = "ËãÇäíÉ" Then
Result = " ËãÇäãÇÆÉ "

ElseIf T = "ÊÓÚÉ" Then
Result = " ÊÓÚãÇÆÉ "
Else
Result = T & " ãÆÉ "
End If
End If

'Convert the tens æ æÇÍÏs place
If Mid(myNumber, 2, 1) <> "0" Then

T = GetTens(Mid(myNumber, 2))
If Result = "" Then
Result = T
Else
Result = Result & "æ " & T
End If
ElseIf Mid(myNumber, 3, 1) <> "0" Then

T = GetDigit(Mid(myNumber, 3))
If Result = "" Then
Result = T
Else
Result = Result & "æ " & T
End If
End If

GetHundreds = Result
End Function

'*********************************************
' Converts a number from 10 to 99 into text. *
'*********************************************

Function GetTens(ByVal TensText As String) As String
Dim Result As String

Result = "" 'null out the temporary function value
If Val(Left(TensText, 1)) = 1 Then ' If value between 10-19
Select Case Val(TensText)
Case 10: Result = "ÚÔÑÉ"
Case 11: Result = "ÇÍÏ ÚÔÑ"
Case 12: Result = "ÇËäÇ ÚÔÑ"
Case 13: Result = "ËáÇËÉ ÚÔÑ"
Case 14: Result = "ÃÑÈÚÉ ÚÔÑ"
Case 15: Result = "ÎãÓÉ ÚÔÑ"
Case 16: Result = "ÓÊÉ ÚÔÑ"
Case 17: Result = "ÓÈÚÉ ÚÔÑ"
Case 18: Result = "ËãÇäíÉ ÚÔÑ"
Case 19: Result = "ÊÓÚÉ ÚÔÑ"
Case Else
Result = ""
End Select
Else ' If value between 20-99
Select Case Val(Left(TensText, 1))
Case 2: Result = "ÚÔÑæä "
Case 3: Result = "臂辊 "
Case 4: Result = "ÃÑÈÚæä "
Case 5: Result = "ÎãÓæä "
Case 6: Result = "ÓÊæä "
Case 7: Result = "ÓÈÚæä "
Case 8: Result = "ËãÇäæä "
Case 9: Result = "ÊÓÚæä "
Case Else
End Select
If GetDigit(Right(TensText, 1)) = "" Then
Result = GetDigit(Right(TensText, 1)) & Result
Else
Result = GetDigit(Right(TensText, 1)) & " æ " & Result

End If
End If
GetTens = Result
End Function

'*******************************************
' Converts a number from 1 to 9 into text. *
'*******************************************

Function GetDigit(ByVal Digit As String) As String
Select Case Val(Digit)
Case 1: GetDigit = "æÇÍÏ"
Case 2: GetDigit = "ÇËäíä"
Case 3: GetDigit = "ËáÇËÉ"
Case 4: GetDigit = "ÇÑÈÚÉ"
Case 5: GetDigit = "ÎãÓÉ"
Case 6: GetDigit = "ÓÊÉ"
Case 7: GetDigit = "ÓÈÚÉ"
Case 8: GetDigit = "ËãÇäíÉ"
Case 9: GetDigit = "ÊÓÚÉ"
Case Else: GetDigit = ""
End Select
End Function
Function GetIndex(ByVal S As String) As Byte

If Val(S) = 1 Then
GetIndex = 1
ElseIf Val(S) = 2 Then
GetIndex = 2
ElseIf Val(S) >= 3 And Val(S) <= 10 Then
GetIndex = 3
Else
GetIndex = 1

End If

End Function

[a.s.m.al...@gmail.com]

12,635.00

[mohamd...@gmail.com]

بتاريخ السبت، 6 مارس، 2010 8:12:03 م UTC+1، كتب hesham:
> كيفية تحويل الارقام الى حروف باللغة العربية

Place(2, 1) = " ÃáÝ "

[www.gach...@gmail.com]

Le samedi 6 mars 2010 20:11:02 UTC+1, hesham a écrit :
>

576320.00

[ilyass...@gmail.com]

469000

[khalid...@gmail.com]

On Saturday, March 6, 2010 at 10:11:02 PM UTC+3, hesham wrote:
>

3330

[dents...@gmail.com]

On Saturday, March 6, 2010 at 10:11:02 PM UTC+3, hesham wrote:

> 75,000.00