تفقيط الأرقام بالعربية في Excel وGoogle Sheets مجانا

' =========================================================
' كود تفقيط الأرقام وتحويلها إلى حروف - حصرياً من دنيا التقنية
' يدعم جميع العملات العربية والعالمية والكسور
' =========================================================
Function TafqeetArabic(ByVal MyNumber As Double, Optional MainCurrency As String = "ريال", Optional SubCurrency As String = "هللة") As String
    Dim Reeds As Variant, Tens As Variant, Hundreds As Variant
    Dim Millions As Variant
    Dim DecimalValue As Integer
    Dim WholeNumber As String
    Dim Result As String
    Dim TempString As String
    Dim i As Integer
    
    ' مصفوفات الكلمات الأساسية
    Reeds = Array("", "واحد", "اثنان", "ثلاثة", "أربعة", "خمسة", "ستة", "سبعة", "ثمانية", "تسعة", "عشرة", "أحد عشر", "اثنا عشر", "ثلاثة عشر", "أربعة عشر", "خمسة عشر", "ستة عشر", "سبعة عشر", "ثمانية عشر", "تسعة عشر")
    Tens = Array("", "عشرة", "عشرون", "ثلاثون", "أربعون", "خمسون", "ستون", "سبعون", "ثمانون", "تسعون")
    Hundreds = Array("", "مائة", "مائتان", "ثلاثمائة", "أربعمائة", "خمسمائة", "ستمائة", "سبعمائة", "ثمانمائة", "تسعمائة")
    Millions = Array("", "ألف", "مليون", "مليار", "تريليون")
    
    ' التعامل مع الأصفار
    If MyNumber = 0 Then
        TafqeetArabic = "صفر " & MainCurrency
        Exit Function
    End If
    
    ' فصل العدد الصحيح عن الكسر
    WholeNumber = CStr(Int(MyNumber))
    DecimalValue = Round((MyNumber - Int(MyNumber)) * 100)
    
    ' تفقيط العدد الصحيح
    If WholeNumber > 0 Then
        Dim Parts() As String
        Dim PCount As Integer
        PCount = 0
        
        Dim NumStr As String
        NumStr = WholeNumber
        Do While Len(NumStr) > 0
            ReDim Preserve Parts(PCount)
            If Len(NumStr) <= 3 Then
                Parts(PCount) = NumStr
                NumStr = ""
            Else
                Parts(PCount) = Right(NumStr, 3)
                NumStr = Left(NumStr, Len(NumStr) - 3)
            End If
            PCount = PCount + 1
        Loop
        
        For i = 0 To UBound(Parts)
            Dim GroupValue As Integer
            GroupValue = CInt(Parts(i))
            
            If GroupValue > 0 Then
                TempString = ""
                Dim H As Integer, T As Integer, U As Integer
                H = GroupValue \ 100
                T = GroupValue Mod 100
                
                If H > 0 Then TempString = Hundreds(H)
                
                If T > 0 Then
                    If Len(TempString) > 0 Then TempString = TempString & " و"
                    If T < 20 Then
                        TempString = TempString & Reeds(T)
                    Else
                        U = T Mod 10
                        T = T \ 10
                        If U > 0 Then TempString = TempString & Reeds(U) & " و"
                        TempString = TempString & Tens(T)
                    End If
                End If
                
                If i > 0 Then
                    If GroupValue = 1 Then
                        TempString = Millions(i)
                    ElseIf GroupValue = 2 Then
                        If i = 1 Then TempString = "ألفان"
                        If i = 2 Then TempString = "مليونان"
                        If i = 3 Then TempString = "ملياران"
                    ElseIf GroupValue >= 3 And GroupValue <= 10 Then
                        If i = 1 Then TempString = TempString & " آلاف"
                        If i = 2 Then TempString = TempString & " ملايين"
                        If i = 3 Then TempString = TempString & " مليارات"
                    Else
                        TempString = TempString & " " & Millions(i) & "اً"
                    End If
                End If
                
                If Len(Result) > 0 Then
                    Result = TempString & " و" & Result
                Else
                    Result = TempString
                End If
            End If
        Next i
        Result = Result & " " & MainCurrency
    End If
    
    ' تفقيط الكسر
    If DecimalValue > 0 Then
        Dim DecString As String
        If DecimalValue < 20 Then
            DecString = Reeds(DecimalValue)
        Else
            Dim DT As Integer, DU As Integer
            DT = DecimalValue \ 10
            DU = DecimalValue Mod 10
            If DU > 0 Then
                DecString = Reeds(DU) & " و" & Tens(DT)
            Else
                DecString = Tens(DT)
            End If
        End If
        
        If Len(Result) > 0 Then
            Result = Result & " و" & DecString & " " & SubCurrency & " فقط لا غير."
        Else
            Result = DecString & " " & SubCurrency & " فقط لا غير."
        End If
    Else
        Result = Result & " فقط لا غير."
    End If
    
    TafqeetArabic = Trim(Result)
End Function

/**
 * تحويل الأرقام إلى نصوص باللغة العربية (تفقيط) - دنيا التقنية
 * @param {number} number الرقم المراد تفقيطه
 * @param {string} mainCurrency العملة الأساسية (مثال: "ريال"، "جنيه")
 * @param {string} subCurrency العملة الفرعية (مثال: "هللة"، "قرش")
 * @return النص المفقط
 * @customfunction
 */
function TAFQEET(number, mainCurrency = "ريال", subCurrency = "هللة") {
  if (number === "" || isNaN(number)) return "";
  if (number == 0) return "صفر " + mainCurrency;

  const arUnits = [
    { s: "", d: "", p: "", a: "" },
    { s: "ألف", d: "ألفان", p: "آلاف", a: "ألفاً" },
    { s: "مليون", d: "مليونان", p: "ملايين", a: "مليوناً" },
    { s: "مليار", d: "ملياران", p: "مليارات", a: "ملياراً" },
    { s: "تريليون", d: "تريليونان", p: "تريليونات", a: "تريليوناً" }
  ];
  
  const arOnes = ["", "واحد", "اثنان", "ثلاثة", "أربعة", "خمسة", "ستة", "سبعة", "ثمانية", "تسعة"];
  const arTens = ["", "عشرة", "عشرون", "ثلاثون", "أربعون", "خمسون", "ستون", "سبعون", "ثمانون", "تسعون"];
  const arTeens = ["عشرة", "أحد عشر", "اثنا عشر", "ثلاثة عشر", "أربعة عشر", "خمسة عشر", "ستة عشر", "سبعة عشر", "ثمانية عشر", "تسعة عشر"];
  const arHundreds = ["", "مائة", "مائتان", "ثلاثمائة", "أربعمائة", "خمسمائة", "ستمائة", "سبعمائة", "ثمانمائة", "تسعمائة"];

  function tafqeetArabicWhole(numStr) {
    if (numStr === "0" || numStr === "") return "صفر";
    let parts = [];
    let str = numStr;
    while (str.length > 0) {
      parts.unshift(parseInt(str.slice(-3), 10));
      str = str.slice(0, -3);
    }
    
    let words = [];
    let scaleIdx = parts.length - 1;

    for (let i = 0; i < parts.length; i++) {
      let p = parts[i];
      if (p === 0) { scaleIdx--; continue; }

      let h = Math.floor(p / 100), rem = p % 100, t = Math.floor(rem / 10), o = rem % 10;
      let partWords = [];

      if (h > 0) partWords.push(arHundreds[h]);
      if (rem > 0) {
        if (rem < 10) partWords.push(arOnes[o]);
        else if (rem < 20) partWords.push(arTeens[rem - 10]);
        else {
          if (o > 0) partWords.push(arOnes[o] + " و" + arTens[t]);
          else partWords.push(arTens[t]);
        }
      }

      let partStr = partWords.join(" و");

      if (scaleIdx > 0) {
        if (p === 1) partStr = arUnits[scaleIdx].s;
        else if (p === 2) partStr = arUnits[scaleIdx].d;
        else if (p >= 3 && p <= 10) partStr += " " + arUnits[scaleIdx].p;
        else partStr += " " + arUnits[scaleIdx].a;
      }
      words.push(partStr);
      scaleIdx--;
    }
    return words.filter(w => w !== "").join(" و");
  }

  let wholeNumber = Math.floor(number).toString();
  let decimalValue = Math.round((number - Math.floor(number)) * 100);
  let result = "";

  if (parseInt(wholeNumber) > 0) {
    let mainText = tafqeetArabicWhole(wholeNumber);
    if (parseInt(wholeNumber) === 1) result = mainCurrency;
    else if (parseInt(wholeNumber) === 2) result = mainCurrency + "ان";
    else result = mainText + " " + mainCurrency;
  }

  if (decimalValue > 0) {
    let decText = tafqeetArabicWhole(decimalValue.toString());
    if (result !== "") result += " و" + decText + " " + subCurrency + " فقط لا غير.";
    else result = decText + " " + subCurrency + " فقط لا غير.";
  } else {
    result += " فقط لا غير.";
  }

  return result.trim();
}