مدير عام منتديات جريت بلينز العربية تاريخ التسجيل: May 2007 الدولة: المملكة العربية السعودية - جـدة المشاركات: 2,560 من مواضيعي | | | ولا يهمك أخي حسن ... والله ما اخرب عليك الفرحة تفضل هذا لكود يظهر لك العربي .... كود: Public Function ConvertCurrencyToArabic(MyNumber As String) As String
Dim temp
Dim Riyal, Halalah
Dim DecimalPlace, Count, CountDigit
ReDim Place(9) As String
Place(2) = "ÃáÜÜÜÝ æ"
Place(3) = "ãÜáÜíÜæä æ "
Place(4) = "ÈÜáÜíÜæä æ"
Place(5) = "ÊÜÑáíæä æ"
MyNumber = Trim(Str(MyNumber))
DecimalPlace = InStr(MyNumber, ".")
If DecimalPlace > 0 Then
temp = Left(Mid(MyNumber, DecimalPlace + 1) & "00", 2)
Halalah = ConvertTens(temp)
MyNumber = Trim(Left(MyNumber, DecimalPlace - 1))
End If
Count = 1
CountDigit = 3
Do While MyNumber <> ""
If Left(MyNumber, 1) = "2" And Len(MyNumber) = 4 And Mid(MyNumber, 2, 3) <> "000" Then
Riyals = "à áÝÇä æ"
temp = ConvertHundreds(Right(MyNumber, 3))
Riyals = Riyals & temp
Exit Do
End If
If Left(MyNumber, 1) = "2" And Len(MyNumber) = 4 And Mid(MyNumber, 2, 3) = "000" Then
Riyals = "à áÝÇä "
Exit Do
End If
If Left(MyNumber, 1) = "1" And Len(MyNumber) = 4 And Mid(MyNumber, 2, 3) <> "000" Then
Riyals = "ÃáÝ æ"
temp = ConvertHundreds(Right(MyNumber, 3))
Riyals = Riyals & temp
Exit Do
End If
If Left(MyNumber, 1) = "1" And Len(MyNumber) = 4 And Mid(MyNumber, 2, 3) = "000" Then
Riyals = "ÃáÝ "
Exit Do
End If
If Left(MyNumber, 1) = "3" And Len(MyNumber) = 4 And Mid(MyNumber, 2, 3) <> "000" And CountDigit = 3 Then
Riyals = "ËáÇËÉ ÂáÇÝ æ"
temp = ConvertHundreds(Right(MyNumber, 3))
Riyals = Riyals & temp
Exit Do
End If
If Left(MyNumber, 1) = "3" And Len(MyNumber) = 4 And Mid(MyNumber, 2, 3) = "000" And CountDigit = 3 Then
Riyals = "ËáÇËÉ ÂáÇÝ "
Exit Do
End If
If Left(MyNumber, 1) = "4" And Len(MyNumber) = 4 And Mid(MyNumber, 2, 3) <> "000" And CountDigit = 3 Then
Riyals = "ÃÑÈÚÉ ÂáÇÝ æ"
temp = ConvertHundreds(Right(MyNumber, 3))
Riyals = Riyals & temp
Exit Do
End If
If Left(MyNumber, 1) = "4" And Len(MyNumber) = 4 And Mid(MyNumber, 2, 3) = "000" And CountDigit = 3 Then
Riyals = "ÃÑÈÚÉ ÂáÇÝ "
Exit Do
End If
If Left(MyNumber, 1) = "5" And Len(MyNumber) = 4 And Mid(MyNumber, 2, 3) <> "000" And CountDigit = 3 Then
Riyals = "ÎãÓÉ ÂáÇÝ æ"
temp = ConvertHundreds(Right(MyNumber, 3))
Riyals = Riyals & temp
Exit Do
End If
If Left(MyNumber, 1) = "5" And Len(MyNumber) = 4 And Mid(MyNumber, 2, 3) = "000" And CountDigit = 3 Then
Riyals = "ÎãÓÉ ÂáÇÝ "
Exit Do
End If
If Left(MyNumber, 1) = "6" And Len(MyNumber) = 4 And Mid(MyNumber, 2, 3) <> "000" And CountDigit = 3 Then
Riyals = "ÓÊÉ ÂáÇÝ æ"
temp = ConvertHundreds(Right(MyNumber, 3))
Riyals = Riyals & temp
Exit Do
End If
If Left(MyNumber, 1) = "6" And Len(MyNumber) = 4 And Mid(MyNumber, 2, 3) = "000" And CountDigit = 3 Then
Riyals = "ÓÊÉ ÂáÇÝ "
Exit Do
End If
If Left(MyNumber, 1) = "7" And Len(MyNumber) = 4 And Mid(MyNumber, 2, 3) <> "000" And CountDigit = 3 Then
Riyals = "ÓÈÚÉ ÂáÇÝ æ"
temp = ConvertHundreds(Right(MyNumber, 3))
Riyals = Riyals & temp
Exit Do
End If
If Left(MyNumber, 1) = "7" And Len(MyNumber) = 4 And Mid(MyNumber, 2, 3) = "000" And CountDigit = 3 Then
Riyals = "ÓÈÚÉ ÂáÇÝ "
Exit Do
End If
If Left(MyNumber, 1) = "8" And Len(MyNumber) = 4 And Mid(MyNumber, 2, 3) <> "000" And CountDigit = 3 Then
Riyals = "ËãÇäíÉ ÂáÇÝ æ"
temp = ConvertHundreds(Right(MyNumber, 3))
Riyals = Riyals & temp
Exit Do
End If
If Left(MyNumber, 1) = "8" And Len(MyNumber) = 4 And Mid(MyNumber, 2, 3) = "000" And CountDigit = 3 Then
Riyals = "ËãÇäíÉ ÂáÇÝ "
Exit Do
End If
If Left(MyNumber, 1) = "9" And Len(MyNumber) = 4 And Mid(MyNumber, 2, 3) <> "000" And CountDigit = 3 Then
Riyals = "ÊÓÚÉ ÂáÇÝ æ"
temp = ConvertHundreds(Right(MyNumber, 3))
Riyals = Riyals & temp
Exit Do
End If
If Left(MyNumber, 1) = "9" And Len(MyNumber) = 4 And Mid(MyNumber, 2, 3) = "000" And CountDigit = 3 Then
Riyals = "ÊÓÚÉ ÂáÇÝ "
Exit Do
End If
If Left(MyNumber, 2) = "10" And Len(MyNumber) = 5 And Mid(MyNumber, 2, 4) <> "0000" And CountDigit = 3 Then
Riyals = "ÚÔÑÉ ÂáÇÝ æ"
temp = ConvertHundreds(Right(MyNumber, 3))
Riyals = Riyals & temp
Exit Do
End If
If Left(MyNumber, 1) = "1" And Len(MyNumber) = 5 And Mid(MyNumber, 2, 4) = "0000" And CountDigit = 3 Then
Riyals = "ÚÔÑÉ ÂáÇÝ "
Exit Do
End If
temp = ConvertHundreds(Right(MyNumber, 3))
If temp <> "" Then
Riyals = temp & " " & Place(Count) & " " & Riyals
End If
If Len(MyNumber) > 3 Then
MyNumber = Left(MyNumber, Len(MyNumber) - 3)
Else
MyNumber = ""
End If
Count = Count + 1
CountDigit = CountDigit + 3
Loop
Select Case Riyals
Case ""
Riyals = "áÇíæÌÏ ãÈáÛ"
Case "One"
Riyals = " ÑíÇá æÇÍÜÏ "
Case Else
Riyals = Riyals & " ÑíÜÜÇá "
End Select
Select Case Halalah
Case ""
Halalah = " ÝÞØ áÇ ÛíÑ"
Case "æÇÍÏ"
Halalah = " æ åááÉ æÇÍÏÉ ÝÞØ áÇ ÛíÑ"
Case Else
Halalah = " æ " & Halalah & " åááÉ ÝÞØ áÇ ÛíÑ"
End Select
ConvertCurrencyToArabic = Riyals & Halalah
End Function __________________ Monzer Osama Saudia Arabia - Jeddah 00966501826235 Microsoft Certified Business Management Solutions Professional Microsoft Certified Trainer آخر تعديل بواسطة Monzer Osama ، 06-Sep-2007 الساعة 06:51 PM. |