Monzer Osama | 06-Sep-2011 06:04 PM | ولا يهمك أخي حسن ... والله ما اخرب عليك الفرحة :) تفضل هذا لكود يظهر لك العربي .... كود:
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 |