تعديل كود التفقيط

السلام عليكم ورحمة الله وبركاته

هذا مثال رائع للتفقيط للاستاذ ابوهادي

'-- Abo Hadi, 28/07/2003 --'
'-- Last update on 28/07/2006

Option Explicit

Public Const vArabic As Byte = 1
Public Const vEnglish As Byte = 2
Public Const vMale As Byte = 0
Public Const vFemale As Byte = 1

Private Function myNz(ByVal InValue, Optional ByVal ValueIfNull = Null)
  myNz = IIf(IsNull(InValue), IIf(IsNull(ValueIfNull), Empty, ValueIfNull), InValue)
End Function

Private Function Delete(S As String, Index As Integer, Count As Integer) As String
  Delete = Left(S, Index - 1) + _
           Mid(S, Index + Count, Len(S))
End Function

Private Function Insert(Source, S As String, Index As Integer) As String
  Dim LPart As String
  Dim RPart As String
  
  LPart = Left(S, Index - 1)
  RPart = Mid(S, Index, Len(S))
  Insert = LPart & Source & RPart
End Function

Private Function AddAnd(s1 As String, S2 As String, S3 As String, _
                        And_ As String, Lang As Byte) As String
  Dim InAnd_   As String
  Dim CollectS As String
    
  If Lang = vArabic Then InAnd_ = " " + And_ Else InAnd_ = And_ + " "
  If (s1 <> "") And (S2 <> "") Then And_ = InAnd_ Else And_ = ""
  CollectS = s1 + And_ + S2
  If (CollectS <> "") And (S3 <> "") Then And_ = InAnd_ Else And_ = ""
  AddAnd = CollectS + And_ + S3
End Function

Private Function S2Double(Single_ As Variant, Sex As Byte) As String
  Dim LLeter As Integer
  Dim K      As Byte
  Dim Sngl_1 As String
  Dim Sngl_2 As String
  
  K = InStr(1, Single_ & " ", " ")
  Sngl_1 = Left(Single_, K - 1)
  Sngl_2 = ""
  If K < Len(Single_) Then
    Sngl_2 = Mid(Single_, K + 1, Len(Single_))
  End If
  
  If Sngl_2 <> "" Then
    If Right(Sngl_2, 1) = "ة" Then
      Sngl_2 = Left(Sngl_2, Len(Sngl_2) - 1) & "تان"
    Else
      Sngl_2 = Sngl_2 & "ان"
    End If
  End If
  
  If Sngl_1 <> "" Then LLeter = Asc(Right(Sngl_1, 1))
  
  Select Case LLeter
    Case 201 ' "ة"
      Sngl_1 = Left(Sngl_1, Len(Sngl_1) - 1) & "تان"
    Case 236 ' "ى"
      Sngl_1 = Left(Sngl_1, Len(Sngl_1) - 1) & "يان"
    Case 199 ' "ا"
      Sngl_1 = Left(Sngl_1, Len(Sngl_1) - 1) & "وان"
    Case 193 ' "ء"
      If Right(Sngl_1, 2) = "اء" Then
        If Sex = 1 Then
          Sngl_1 = Left(Sngl_1, Len(Sngl_1) - 1) & "وان"
        Else
          Sngl_1 = Sngl_1 & "ان"
        End If
      End If
    Case Else
      If Sngl_1 <> "" Then Sngl_1 = Sngl_1 & "ان"
  End Select
  
  If Sngl_2 <> "" Then
    S2Double = Sngl_1 & " " & Sngl_2
  Else
    S2Double = Sngl_1
  End If
End Function

Private Function Fmale(Num As Byte, Sex As Byte, Female()) As String
  Dim Two(1 To 4) As String
  Dim InSex As Byte
    
  Two(1) = "أحد"
  Two(2) = "اثنان"
  Two(3) = "إحدى"
  Two(4) = "ة"
      
  Select Case Sex
    Case vMale:
      Select Case Num
        Case 1:             Fmale = Mid(Female(1), 1, 4)
        Case 2:             Fmale = Two(2)
        Case 8:             Fmale = Female(Num) + "ي" + Two(4)
        Case 3 To 7, 9, 10: Fmale = Female(Num) + Two(4)
        Case 11:            Fmale = Two(1) + " " + Female(10)
        Case 12:            Fmale = Mid(Two(2), 1, 4) + " " + Female(10)
        Case 13 To 19:      Fmale = Female(Num - 10) + Two(4) + " " + Female(10)
      End Select
    Case vFemale:
      Select Case Num
        Case 1 To 10:       Fmale = Female(Num)
        Case 11:            Fmale = Two(3) + " " + Female(10) + Two(4)
        Case 12:            Fmale = Mid(Female(2), 1, 5) + " " + Female(10) + Two(4)
        Case 13 To 19:      Fmale = Female(Num - 10) + " " + Female(10) + Two(4)
      End Select
    End Select
End Function

Private Function Tens(Num As Byte, Female()) As String
  Const Noon = "ون"
      
  Select Case Num
    Case 2:      Tens = Female(10) + Noon
    Case 3 To 9: Tens = Female(Num) + Noon
  End Select
End Function

Private Function Hunds(Num As Byte, Female()) As String
  Const Hund = "مائة"
      
  Select Case Num
    Case 1:      Hunds = Hund
    Case 2:      Hunds = Mid(Hund, 1, 3) + Mid(Female(2), 4, 3)
    Case 3 To 9: Hunds = Female(Num) + Hund
   End Select
End Function

Private Function Tenteen(Num As Byte, ETens()) As String
  Const een = "een"
  
  Num = Num Mod 10
  Select Case Num
    Case 3 To 9:
      Tenteen = Mid(ETens(Num), 1, Len(ETens(Num)) - 1) + een
  End Select
End Function

Private Function EHunds(Num As Byte, ESingle()) As String
  EHunds = ESingle(Num) + " hundred"
End Function

Private Function AOnly(Num_ As String, FracS As String, Single_ As String, _
                       Plural As String, Parts As Byte, Sex As Byte, Dec As Byte) As String
  
  Const And_ As String * 1 = "و"
  
  
  Const Lang = vArabic
  Dim PartNum(0 To 7) As Long
  Dim Result1(0 To 8) As String
  Dim Parts_(0 To 13) As String
  Dim Female(1 To 10) As Variant
  Dim TempI           As Byte
  Dim Sex2            As Byte
  Dim K               As Byte
  Dim Only_           As String
  Dim OnlyPart        As String
  Dim Part_           As String
  Dim TempS           As String
  Dim Sngl_1          As String
  Dim Sngl_2          As String
  Dim n1  As Byte, N2    As Byte, n3    As Byte
  Dim N1_ As String, N2_ As String, N3_ As String
    
  If Val(Num_) = 0 Then
    If FracS = "" Then
      AOnly = RTrim("صفر " & Single_)
    Else
      AOnly = FracS & " " & Single_
    End If
    Exit Function
  End If
  
  Female(1) = "واحدة"
  Female(2) = "اثنتان"
  Female(3) = "ثلاث"
  Female(4) = "أربع"
  Female(5) = "خمس"
  Female(6) = "ست"
  Female(7) = "سبع"
  Female(8) = "ثمان"
  Female(9) = "تسع"
  Female(10) = "عشر"
   
  Parts_(0) = ""
  Parts_(1) = "ألف"
  Parts_(2) = "مليون"
  Parts_(3) = "مليار"
  Parts_(4) = "ترليون"
  Parts_(5) = "كدرليون"
  Parts_(6) = "كوينتليون"
  Parts_(7) = ""
  Parts_(8) = "آلاف"
  Parts_(9) = "ملايين"
  Parts_(10) = "مليارات"
  Parts_(11) = "ترليونات"
  Parts_(12) = "كدرليونات"
  Parts_(13) = "كوينتليونات"
  
  K = InStr(1, Single_ & " ", " ")
  Sngl_1 = Left(Single_, K - 1)
  Sngl_2 = ""
  If K < Len(Single_) Then
    Sngl_2 = Mid(Single_, K + 1, Len(Single_))
  End If
  
  If Sngl_2 <> "" And InStr(2, Plural, Sngl_2) > 0 Then
    Sngl_2 = ""
  End If
  
  For K = 0 To Parts - 1
    PartNum(K) = Val(Mid(Num_, (K * 3) + 1, 3))
  Next K
    
    Sex2 = Sex
    For K = 0 To (Parts - 1)
      If K = (Parts - 1) Then Sex = Sex2 Else Sex = vMale
      TempS = Mid(Num_, (K * 3) + 1, 3)
      TempI = Val(Mid(TempS, 2, 2))
      
      n1 = Val(Mid(TempS, 1, 1))
      N2 = Val(Mid(TempS, 2, 1))
      n3 = Val(Mid(TempS, 3, 1))
      '{------------------------------------------}
      N1_ = "": N2_ = "": N3_ = ""
      If n1 > 0 Then N1_ = Hunds(CByte(n1), Female())
      If PartNum(K) = 200 Then N1_ = Mid(N1_, 1, Len(N1_) - 1)
      Select Case TempI
        Case 1 To 2:
          If K = Parts - 1 Then If FracS <> "" Then N3_ = Fmale(n3, CByte(Sex), Female())  'Sex
        Case 3 To 19:
          N3_ = Fmale(TempI, CByte(Sex), Female())
        Case 20 To 99:
          N2_ = Tens(CByte(N2), Female())
          If n3 > 0 Then N3_ = Fmale(n3, CByte(Sex), Female())
          If (n3 Mod 10 = 1) And (Sex = vFemale) Then N3_ = "إحدى"
      End Select
      OnlyPart = AddAnd(N1_, N3_, N2_, And_, Lang)
      '{------------------------------------------}
      If PartNum(K) > 100 Then
        Select Case TempI
          Case 1, 2:
            OnlyPart = AddAnd(OnlyPart, Parts_(Parts - K - 1), "", "", Lang)
        End Select
      End If
      '{------------------------------------------}
      Part_ = ""
      If PartNum(K) > 0 Then
        Part_ = Parts_(Parts - K - 1)
        If Part_ <> "" Then
          Select Case TempI
            Case 2:        Part_ = Part_ + "ان"
            Case 3 To 10:  Part_ = Parts_((Parts - K - 1) + 7)
            Case 11 To 99: Part_ = Part_ + "ا"
          End Select
        End If
      End If
      '{------------------------------------------}
      If Part_ <> "" Then
        If TempI >= 1 And TempI <= 2 Then
           OnlyPart = AddAnd(OnlyPart, Part_, "", And_, Lang)
        Else
          OnlyPart = AddAnd(OnlyPart, Part_, "", "", Lang)
        End If
      End If
      Result1(K) = OnlyPart
    Next K
    '{------------------------------------------}
    For K = 0 To Parts - 1
      Only_ = AddAnd(Only_, Result1(K), "", And_, Lang)
    Next K

    If FracS <> "" Then
      If Only_ <> "" Then FracS = " " + FracS
      Only_ = AddAnd(Only_, FracS, "", And_, Lang)
    End If
    If Only_ <> "" Then
      If Mid(Only_, Len(Only_), 1) = "ا" Then
        If Mid(Only_, Len(Only_) - 1, 2) <> "تا" Then
          Only_ = Mid(Only_, 1, Len(Only_) - 1)
        End If
      End If
      If TempS = "000" Then
        If Mid(Only_, Len(Only_) - 1, 2) = "ان" Then
          Only_ = Mid(Only_, 1, Len(Only_) - 1)
        End If
      End If
    End If
    '{------------------------------------------}
    If FracS = "" Then
      Select Case TempI
        Case 0: If Only_ <> "" Then Only_ = AddAnd(Only_, Single_, "", "", Lang)
        Case 1: Only_ = AddAnd(Only_, AddAnd(Single_, Fmale(1, CByte(Sex), Female()), "", "", Lang), "", And_, Lang)
        Case 2: Only_ = AddAnd(Only_, AddAnd(S2Double(Single_, CByte(Sex)), Fmale(2, CByte(Sex), Female()), "", "", Lang), "", And_, Lang)
        Case 3 To 10:
          If Sngl_2 <> "" Then
            If Right(Sngl_2, 1) = "ة" Then
              Only_ = AddAnd(Only_, Plural, Sngl_2, "", Lang)
            Else
              Only_ = AddAnd(Only_, Plural, Sngl_2 & "ة", "", Lang)
            End If
          Else
            Only_ = AddAnd(Only_, Plural, "", "", Lang)
          End If
        Case 11 To 99:
          If Sngl_1 <> "" Then
            Only_ = AddAnd(Only_, Sngl_1, "", "", Lang)
            N1_ = Mid(Only_, Len(Only_), 1)
            Select Case N1_
              Case "ة", "ى", "ا"
              Case Else
                Only_ = Only_ + "ا"
            End Select
            N1_ = Mid(Only_, Len(Only_) - 2, 3)
            'هذا الشرط لحل مشكلة عدم التمييز بين "ء" و "ل" 2002/08/24
            If N1_ = "اءا" And Asc(Right(Sngl_1, 1)) = 193 Then
              Only_ = Left(Only_, Len(Only_) - 1)
            End If
            If Sngl_2 <> "" Then
              If Right(Only_, 1) = "ا" Then
                Only_ = AddAnd(Only_, Sngl_2 & "ا", "", "", Lang)
              Else
                Only_ = AddAnd(Only_, Sngl_2, "", "", Lang)
              End If
            Else
              Only_ = AddAnd(Only_, Sngl_2, "", "", Lang)
            End If
          End If
      End Select
    Else
      Only_ = AddAnd(Only_, Sngl_1, Sngl_2, "", Lang)
    End If
    AOnly = (Only_)
End Function

Private Function EOnly(Num_ As String, FracS As String, Single_ As String, _
                       Plural As String, Parts As Byte, Dec As Byte) As String
  Const Lang = vEnglish
  Dim ESingle(1 To 12) As Variant
  Dim ETens(2 To 9)    As Variant
  Dim EParts_(0 To 6)  As String
  Dim PartNum(0 To 6)  As Long
  Dim Result1(0 To 6)  As String
  Dim TempS            As String
  Dim TempI            As Byte
  Dim Sex2             As Byte
  Dim OnlyPart         As String
  Dim Part_            As String
  Dim Only_            As String
  Dim LENG             As Integer
  Dim K                As Integer
  Dim n1  As Byte, N2    As Byte, n3    As Byte
  Dim N1_ As String, N2_ As String, N3_ As String
  
  If Val(Num_) = 0 Then
    If FracS = "" Then
      EOnly = RTrim("zero " & Single_)
    Else
      EOnly = Single_ & " " & FracS
    End If
    Exit Function
  End If
  
  ESingle(1) = "one"
  ESingle(2) = "two"
  ESingle(3) = "three"
  ESingle(4) = "four"
  ESingle(5) = "five"
  ESingle(6) = "six"
  ESingle(7) = "seven"
  ESingle(8) = "eight"
  ESingle(9) = "nine"
  ESingle(10) = "ten"
  ESingle(11) = "eleven"
  ESingle(12) = "twelve"
  
  ETens(2) = "twenty"
  ETens(3) = "thirty"
  ETens(4) = "forty"
  ETens(5) = "fifty"
  ETens(6) = "sixty"
  ETens(7) = "seventy"
  ETens(8) = "eighty"
  ETens(9) = "ninety"
  
  EParts_(0) = ""
  EParts_(1) = "thousund"
  EParts_(2) = "million"
  EParts_(3) = "billion"
  EParts_(4) = "trillion"
  EParts_(5) = "quadrillion"
  EParts_(6) = "quintillion"
  
  For K = 0 To Parts - 1
    PartNum(K) = Val(Mid(Num_, (K * 3) + 1, 3))
  Next K
  
  For K = 0 To (Parts - 1)
    TempS = Mid(Num_, (K * 3) + 1, 3)
    TempI = Val(Mid(TempS, 2, 2))
    n1 = Val(Mid(TempS, 1, 1))
    N2 = Val(Mid(TempS, 2, 1))
    n3 = Val(Mid(TempS, 3, 1))
    '{------------------------------------------}
    N1_ = "": N2_ = "": N3_ = ""
    If n1 > 0 Then N1_ = EHunds(CByte(n1), ESingle())
    Select Case TempI
      Case 1 To 12:  N3_ = ESingle(TempI)
      Case 13 To 19: If n3 > 0 Then N3_ = Tenteen(CByte(TempI), ETens())
      Case 20 To 99:
        N2_ = ETens(N2)
        If n3 > 0 Then
          N3_ = N2_ + "-" + ESingle(n3)
          N2_ = ""
        End If
    End Select
    OnlyPart = AddAnd(N1_, N2_, N3_, "", Lang)
    '{------------------------------------------}
    Part_ = ""
    If PartNum(K) > 0 Then
      Part_ = EParts_(Parts - K - 1)
      If Part_ <> "" Then Part_ = EParts_((Parts - K - 1))
    End If
    Result1(K) = AddAnd(OnlyPart, Part_, "", "", Lang)
  Next K
  '{------------------------------------------}
  For K = 0 To Parts - 1
    Only_ = AddAnd(Only_, Result1(K), "", "", Lang)
  Next K
  
  LENG = Len(Only_)
  Only_ = AddAnd(Only_, FracS, "", " and", Lang)
  If Only_ <> "" Then
    If Val(Num_) = 1 Then
      Only_ = AddAnd(Only_, Single_, "", "", Lang)
    Else
      Only_ = AddAnd(Only_, Plural, "", "", Lang)
    End If
    EOnly = Only_
  End If
End Function

Private Function S_Only(InNum As Variant, Lang As Byte, FracType As Byte) As Variant
  Dim Num_  As String
  Dim K     As Byte
  Dim Dec   As Byte
  Dim FType As Byte
  
  If IsNull(InNum) Then
    S_Only = Null
    Exit Function
  End If
  
  Num_ = CStr(InNum)
  K = InStr(1, Num_, ".", 1)
  If K > 0 Then
    Dec = Len(Num_) - K
   'If Dec < 2 Then Dec = 2
  Else
   Dec = 0
  End If
  
  FType = FracType
  If FType <> 2 Then FType = 1
  
  S_Only = B_Only(InNum, Lang, 0, Dec, "", "", 0, "", "", FType)
End Function
  
Private Function B_Only(InNum As Variant, Lang As Byte, Sex As Byte, Dec As Byte, _
                        Single_ As String, Plural As String, _
                        FSex As Byte, SFrac As String, PFrac As String, _
                        FracType As Byte) As Variant
  Dim LENG    As Byte
  Dim Parts   As Byte
  Dim K       As Byte
  Dim FracVal As Double
  Dim Num_    As String
  Dim FracS   As String
  Dim FracNum As String
  Dim Only    As String
  Dim And_    As String
  
  If IsNull(InNum) Then
    B_Only = Null
    Exit Function
  End If
  
  If Dec > 6 Then Dec = 6
  Num_ = Format(InNum, "0" & IIf(Dec > 0, ".", "") & String(Dec, "0"))
  If Dec > 0 Then FracS = "0." & Right(Num_, Dec) Else FracS = ""
  If Dec > 0 Then Num_ = Left(Num_, Len(Num_) - Dec - 1)
  FracVal = Val(FracS)
  
  Do While Len(FracS) < Dec + 2
    FracS = Insert(FracS, "0", 1)
  Loop

DoProcess:
  If FracVal = 0 Then FracS = ""
  FracNum = Trim(Mid(FracS, 3, Len(FracS)))
  If FracS <> "" Then
    Select Case FracType
      Case 2
        Select Case Lang
          Case vArabic:  FracS = "1" & String(Dec, "0") & "/" & CDbl(Format(FracNum, String(Dec, "0")))
          Case vEnglish: FracS = CDbl(Format(FracNum, String(Dec, "0"))) & "/" & "1" & String(Dec, "0")
        End Select
      Case 3
        Select Case Lang
          Case vArabic:  FracS = CLng(FracNum) & " " & IIf(FracNum >= 3 And FracNum <= 10, PFrac, SFrac)
          Case vEnglish: FracS = CLng(FracNum) & " " & IIf(FracNum > 1, PFrac, SFrac)
        End Select
      Case 4
        LENG = Len(FracNum)
        Parts = Fix((LENG + 2) / 3)
        For K = 1 To (Parts * 3) - LENG
          FracNum = Insert("0", FracNum, 1)
        Next K
        Select Case Lang
          Case vArabic:  FracS = AOnly(FracNum, "", SFrac, PFrac, Parts, FSex, FracType)
          Case vEnglish: FracS = EOnly(FracNum, "", SFrac, PFrac, Parts, 0)
        End Select
    End Select
  End If
  
  LENG = Len(Num_)
  Parts = Fix((LENG + 2) / 3)
  
  If Parts > 7 Then
    B_Only = InNum
    Exit Function
  End If
  
  For K = 1 To (Parts * 3) - LENG
    Num_ = Insert("0", Num_, 1)
  Next K
  
  Select Case FracType
    Case 1, 2
      Select Case Lang
        Case vArabic:  Only = AOnly(Num_, FracS, Single_, Plural, Parts, Sex, Dec)
        Case vEnglish: Only = EOnly(Num_, FracS, Single_, Plural, Parts, Dec)
      End Select
    Case 3, 4
      Select Case Lang
        Case vArabic:  Only = AOnly(Num_, "", Single_, Plural, Parts, Sex, Dec)
                       If CDbl(Num_) = 0 And FracS <> "" Then Only = ""
                       If FracType = 3 Then And_ = "و " Else And_ = "و"
                       If FracS <> "" Then Only = AddAnd(Only, FracS, "", And_, CByte(Lang))
        Case vEnglish: Only = EOnly(Num_, "", Single_, Plural, Parts, Dec)
                       If CDec(Num_) = 0 And FracS <> "" Then Only = ""
                       If FracS <> "" Then Only = AddAnd(Only, FracS, "", " and", CByte(Lang))
      End Select
  End Select
  
  If Only <> "" Then
    Select Case Lang
      Case vArabic:  B_Only = Only
      Case vEnglish: B_Only = Only
    End Select
  End If
End Function

Function ArbNum2Text(ByVal InNum, _
            Optional ByVal DecimalPlaces = Null, _
            Optional ByVal FractionType = 1, _
            Optional ByVal CurrencySingle = "", _
            Optional ByVal CurrencyPlural = "", _
            Optional ByVal CurrencySex = 0, _
            Optional ByVal FractionSingle = "", _
            Optional ByVal FractionPlural = "", _
            Optional ByVal FractionSex = 0) As Variant
        
  Dim Negative As String
  
  If IsNull(InNum) Then
    ArbNum2Text = Null
    Exit Function
  Else
    If InNum < 0 Then
      InNum = Abs(InNum)
      Negative = "سالب "
    End If
  End If
  
  If IsNull(FractionType) Then FractionType = 1
  
  If myNz(CurrencySingle) = Empty Or myNz(CurrencyPlural) = Empty Then
    If Not IsNull(DecimalPlaces) Then
      InNum = Format(InNum, "0" & IIf(DecimalPlaces > 0, ".", "") & String(DecimalPlaces, "0"))
    End If
    ArbNum2Text = Negative & S_Only(InNum, vArabic, CByte(FractionType))
    Exit Function
  End If
  
  If IsNull(DecimalPlaces) Then DecimalPlaces = 2
  InNum = Format(InNum, "0" & IIf(DecimalPlaces > 0, ".", "") & String(DecimalPlaces, "0"))
 
 'If InNum <> Fix(InNum) Then
  If Val(Right(InNum, DecimalPlaces)) > 0 Then
    If myNz(FractionSingle) = Empty Or myNz(FractionPlural) = Empty Then
      If FractionType > 2 Then FractionType = 1
    End If
  End If
       
  ArbNum2Text = Negative & _
                B_Only(CDec(myNz(InNum, 0)), vArabic, CByte(myNz(CurrencySex)), _
                       CByte(myNz(DecimalPlaces)), CStr(myNz(CurrencySingle)), _
                       CStr(myNz(CurrencyPlural)), CByte(myNz(FractionSex)), _
                       CStr(myNz(FractionSingle)), CStr(myNz(FractionPlural)), _
                       CByte(myNz(FractionType)))
End Function

Function EngNum2Text(ByVal InNum, _
            Optional ByVal DecimalPlaces = Null, _
            Optional ByVal FractionType = 1, _
            Optional ByVal CurrencySingle = "", _
            Optional ByVal CurrencyPlural = "", _
            Optional ByVal FractionSingle = "", _
            Optional ByVal FractionPlural = "") As Variant

  Dim Negative As String
  
  If IsNull(InNum) Then
    EngNum2Text = Null
    Exit Function
  Else
    If InNum < 0 Then
      InNum = Abs(InNum)
      Negative = "Negative "
    Else
      Negative = ""
    End If
  End If
  
  If IsNull(FractionType) Then FractionType = 1
  If myNz(CurrencyPlural) = Empty Then CurrencyPlural = myNz(CurrencySingle, "")
  If myNz(FractionPlural) = Empty Then FractionPlural = myNz(FractionSingle, "")
  
  If myNz(CurrencySingle) = Empty Then
    If Not IsNull(DecimalPlaces) Then
      InNum = Format(InNum, "0" & IIf(DecimalPlaces > 0, ".", "") & String(DecimalPlaces, "0"))
    End If
    EngNum2Text = Negative & S_Only(InNum, vEnglish, CByte(FractionType))
    Exit Function
  End If
  
  If IsNull(DecimalPlaces) Then DecimalPlaces = 2
  InNum = Format(InNum, "0" & IIf(DecimalPlaces > 0, ".", "") & String(DecimalPlaces, "0"))
 
 'If InNum <> Fix(InNum) Then
  If Val(Right(InNum, DecimalPlaces)) > 0 Then
    If myNz(FractionSingle) = Empty Then
      If FractionType > 2 Then FractionType = 1
    End If
  End If
  
  EngNum2Text = Negative & _
                B_Only(CDec(myNz(InNum, 0)), vEnglish, 0, _
                       CByte(myNz(DecimalPlaces)), CStr(myNz(CurrencySingle)), _
                       CStr(myNz(CurrencyPlural)), 0, _
                       CStr(myNz(FractionSingle)), CStr(myNz(FractionPlural)), _
                       CByte(myNz(FractionType)))
End Function

Sub Test()
  Dim Num As Variant
  Dim DecimalPlaces As Byte
  Dim FractionType
  
  Num = -22.22
  DecimalPlaces = 2
  FractionType = 4
  
  'MsgBox ArbNum2Text(Num, DecimalPlaces, FractionType, "ريال", "ريالات", 0, "هللة", "هللات", 1)
  'MsgBox EngNum2Text(Num, DecimalPlaces, FractionType, "Saudi Riyal", "Saudi Riyals", "Halala", "Halalas")
  MsgBox ArbNum2Text(CDec("-123456789012345678901.123456"))
End Sub

كيف يمكن ان استبدل هذه الجملة  Const And_ As String * 1 ="و"

 بهذه الجملة
Const And_ As String * 1 = DLast("[waw]", "[hrof]")
 حيث Const لا تقبل هذا الكود 

Private Function AOnly(Num_ As String, FracS As String, Single_ As String,Plural As String, Parts As Byte, Sex As Byte, Dec As Byte) As String
Const And_ As String * 1 ="و"
' بهذه الجملة
Const And_ As String * 1 = DLast("[waw]", "[hrof]")
' حيث Const لا تقبل هذا الكود