Option Compare Database 'Use database order for string comparisons
Option Explicit
Global Const CCYID_LL = 0
Global Const CCYID_USD = 1
Function CurrencyFormat(CurrencyID As Integer) As String
Select Case CurrencyID
Case CCYID_LL
CurrencyFormat = "#,##0.00 á.á."
Case CCYID_USD
CurrencyFormat = "$#,##0.00"
End Select
End Function
Function CurrencyRate(CurrencyID As Long, ExchangeDate As Variant) As Currency
CurrencyRate = NullToZero(DLookup("[Rate]", "Currencies Rates", "[Currency ID] = " & CurrencyID & " And [Date] = " & CriteriaDate(ExchangeDate)))
End Function
Function CurrencyToText(Number As Currency, CurrencyID As Variant) As String
Const BILLION_PART = 0, MILLION_PART = 1, THOUSAND_PART = 2, HUNDRED_PART = 3, DECIMAL_PART = 4
Static OnesArray(9) As String, TensArray(9) As String, HundredsArray(9) As String
Static Parts(4) As String, PartPower(4, 2) As String, CurrencyName(1, 7) As String
Dim Text As String, partno As Integer
Dim Ones As Integer, Tens As Integer, Hundreds As Integer
Dim OnesText As String, TensText As String, HundredsText As String
Dim IntegerText As String, DecimalText As String
If Number = 0 Then Exit Function
OnesArray(1) = "æÇÍÏ": OnesArray(2) = "ÇËäÇä": OnesArray(3) = "ËáÇËÉ": OnesArray(4) = "ÃÑÈÚÉ": OnesArray(5) = "ÎãÓÉ": OnesArray(6) = "ÓÊÉ": OnesArray(7) = "ÓÈÚÉ": OnesArray(8) = "ËãÇäíÉ": OnesArray(9) = "ÊÓÚÉ"
TensArray(1) = "ÚÔÑ": TensArray(2) = "ÚÔÑæä": TensArray(3) = "ËáÇËæä": TensArray(4) = "ÃÑÈÚæä": TensArray(5) = "ÎãÓæä": TensArray(6) = "ÓÊæä": TensArray(7) = "ÓÈÚæä": TensArray(8) = "ËãÇäæä": TensArray(9) = "ÊÓÚæä"
HundredsArray(1) = "ãÆÉ": HundredsArray(2) = "ãÆÊÇä": HundredsArray(3) = "ËáÇËãÆÉ": HundredsArray(4) = "ÃÑÈÚãÆÉ": HundredsArray(5) = "ÎãÓãÆÉ": HundredsArray(6) = "ÓÊãÆÉ": HundredsArray(7) = "ÓÈÚãÆÉ": HundredsArray(8) = "ËãÇäãÆÉ": HundredsArray(9) = "ÊÓÚãÆÉ"
PartPower(0, 0) = "ãáíÇÑÇÊ": PartPower(0, 1) = "ãáíÇÑ": PartPower(0, 2) = "ãáíÇÑÇä"
PartPower(1, 0) = "ãáÇííä": PartPower(1, 1) = "ãáíæä": PartPower(1, 2) = "ãáíæäÇä"
PartPower(2, 0) = "ÂáÇÝ": PartPower(2, 1) = "ÇáÝ": PartPower(2, 2) = "ÇáÝÇä"
CurrencyName(0, 0) = "áíÑÉ áÈäÇäíÉ": CurrencyName(0, 1) = "áíÑÉ áÈäÇäíÉ æÇÍÏÉ": CurrencyName(0, 2) = "áíÑÊÇä áÈäÇäíÊÇä": CurrencyName(0, 3) = "áíÑÇÊ áÈäÇäíÉ"
CurrencyName(0, 4) = "ÞÑÔÇð": CurrencyName(0, 5) = "ÞÑÔ æÇÍÏ": CurrencyName(0, 6) = "ÞÑÔÇä": CurrencyName(0, 7) = "ÞÑæÔ"
CurrencyName(1, 0) = "ÏæáÇÑ ÇãÑíßí": CurrencyName(1, 1) = "ÏæáÇÑ ÇãÑíßí æÇÍÏ": CurrencyName(1, 2) = "ÏæáÇÑÇä ÇãÑíßíÇä": CurrencyName(1, 3) = "ÏæáÇÑÇÊ ÇãÑíßíÉ"
CurrencyName(1, 4) = "ÓäÊÇð": CurrencyName(1, 5) = "ÓäÊ æÇÍÏ": CurrencyName(1, 6) = "ÓäÊÇä": CurrencyName(1, 7) = "ÓäÊÇÊ"
'ÊÞÓíã æÍÝÙ ÇáÇÌÒÇÁ ÇáÎãÓÉ
Text = Format$(Number, "0.00")
Text = String$(15 - Len(Text), "0") + Text
Mid$(Text, InStr(Text, "."), 1) = "0"
For partno = BILLION_PART To DECIMAL_PART
Parts(partno) = Mid$(Text, (partno * 3) + 1, 3)
Next
'ÊÍæíá ÇáÇÑÞÇã ÇáÕÍíÍÉ Çáì ßáãÇÊ
For partno = BILLION_PART To HUNDRED_PART
If Val(Parts(partno)) Then
GoSub ConvertToText
If IntegerText = "" Then
IntegerText = Text
Else
IntegerText = IntegerText + " " + "æ" + Text
End If
End If
Next
If IntegerText <> "" Then
Text = IntegerText & " " & CurrencyName(CurrencyID, 0)
Select Case Val(Right$(Parts(HUNDRED_PART), 2))
Case 1: If Number < 100 Then Text = CurrencyName(CurrencyID, 1) Else Text = Left$(IntegerText, Len(IntegerText) - Len(OnesArray(1))) & CurrencyName(CurrencyID, 1)
Case 2: If Number < 100 Then Text = CurrencyName(CurrencyID, 2) Else Text = Left$(IntegerText, Len(IntegerText) - Len(OnesArray(2))) & CurrencyName(CurrencyID, 2)
Case 3 To 10: Text = IntegerText & " " & CurrencyName(CurrencyID, 3)
End Select
IntegerText = Text
End If
'ÊÍæíá ÇáÇÑÞÇã ÇáÚÔÑíÉ Çáì ßáãÇÊ
partno = DECIMAL_PART
If Val(Parts(partno)) Then
GoSub ConvertToText
DecimalText = Text
Text = DecimalText & " " & CurrencyName(CurrencyID, 4)
Select Case Val(Parts(DECIMAL_PART))
Case 1: Text = CurrencyName(CurrencyID, 5)
Case 2: Text = CurrencyName(CurrencyID, 6)
Case 3 To 10: Text = DecimalText & " " & CurrencyName(CurrencyID, 7)
End Select
DecimalText = Text
End If
If IntegerText <> "" And DecimalText <> "" Then
CurrencyToText = IntegerText & " æ" & DecimalText & " " & "ÝÞØ áÇ ÛíÑ"
Else
If IntegerText <> "" Then
CurrencyToText = IntegerText & " " & "ÝÞØ áÇ ÛíÑ"
Else
CurrencyToText = DecimalText & " " & "ÝÞØ áÇ ÛíÑ"
End If
End If
Exit Function
ConvertToText:
Ones = Val(Right$(Parts(partno), 1))
Tens = Val(Mid$(Parts(partno), 2, 1))
Hundreds = Val(Left$(Parts(partno), 1))
HundredsText = HundredsArray(Hundreds)
TensText = TensArray(Tens)
OnesText = OnesArray(Ones)
If Tens = 1 Then
Select Case Ones
Case 0: TensText = "ÚÔÑÉ"
Case 1: OnesText = "ÃÍÏ"
Case 2: OnesText = "ÇËäÇ"
End Select
End If
If Hundreds <> 0 Then
If Tens <> 0 Or Ones <> 0 Then HundredsText = HundredsText + " " + "æ"
End If
If Ones <> 0 Then
If Tens = 1 Then OnesText = OnesText + " "
If Tens > 1 Then OnesText = OnesText + " " + "æ"
End If
Select Case partno
Case BILLION_PART To THOUSAND_PART:
Text = HundredsText & OnesText & TensText & " " & PartPower(partno, 1)
If Tens = 0 And Ones = 1 Then Text = HundredsText & PartPower(partno, 1)
If Tens = 0 And Ones = 2 Then Text = HundredsText & PartPower(partno, 2)
If Tens = 1 And Ones = 0 Then Text = HundredsText & TensText + " " + PartPower(partno, 0)
If Tens = 0 And Ones > 2 Then Text = HundredsText & OnesText + " " + PartPower(partno, 0)
Case HUNDRED_PART To DECIMAL_PART:
Text = HundredsText & OnesText & TensText
End Select
Return
End Function
Function CurrencyType(Amount As Currency, CurrencyID As Integer) As String
Select Case CurrencyID
Case CCYID_LL
CurrencyType = Amount & " .á.á"
Case CCYID_USD
CurrencyType = Amount & " $"
End Select
End Function
it writes the numbers in arabic
