Using vb6 create a DLL class to use it in Excel 32bit to Convert numbers to words Tafqeet

tafqeet.cls

Option Explicit

Private Ones As Variant
Private Tens As Variant
Private Hundreds As Variant

Private Sub Class_Initialize()

    Ones = Array("", "واحد", "اثنان", "ثلاثة", "أربعة", _
                 "خمسة", "ستة", "سبعة", "ثمانية", "تسعة", _
                 "عشرة", "أحد عشر", "اثنا عشر", "ثلاثة عشر", _
                 "أربعة عشر", "خمسة عشر", "ستة عشر", _
                 "سبعة عشر", "ثمانية عشر", "تسعة عشر")

    Tens = Array("", "", "عشرون", "ثلاثون", "أربعون", _
                 "خمسون", "ستون", "سبعون", "ثمانون", "تسعون")

    Hundreds = Array("", "مائة", "مائتان", "ثلاثمائة", _
                     "أربعمائة", "خمسمائة", "ستمائة", _
                     "سبعمائة", "ثمانمائة", "تسعمائة")

End Sub

Public Function AmountToArabicWords(ByVal Amount As Double) As String

    Dim IntegerPart As Double
    Dim DecimalPart As Long
    Dim Result As String

    IntegerPart = Fix(Amount)
    DecimalPart = Round((Amount - IntegerPart) * 100)

    Result = "فقط وقدره " & ConvertNumber(IntegerPart)

    Select Case IntegerPart
        Case 1
            Result = Result & " جنيها"
        Case 2
            Result = Result & " جنيهين"
        Case 3 To 10
            Result = Result & " جنيهات"
        Case Else
            Result = Result & " جنيها"

    End Select

    If DecimalPart > 0 Then
        Result = Result & " و " & DecimalPart & " قرشا"
    End If

    Result = Result & " لا غير"

    AmountToArabicWords = Result

End Function

Private Function ConvertNumber(ByVal Num As Double) As String
    Dim Result As String

    Dim Millions As Long
    Dim Thousands As Long
    Dim Rest As Long

    ' ================= Millions =================
    If Num >= 1000000 Then

        Millions = Int(Num \ 1000000)
        Num = Num Mod 1000000

        Select Case Millions

            Case 1
                Result = "مليون"

            Case 2
                Result = "مليونان"

            Case 3 To 10
                Result = ConvertHundreds(Millions) & " ملايين"

            Case Else
                Result = ConvertHundreds(Millions) & " مليون"

        End Select

    End If

    ' ================= Thousands =================
    If Num >= 1000 Then

        Thousands = Int(Num \ 1000)
        Rest = Num Mod 1000

        If Result <> "" Then
            Result = Result & " و "
        End If

        Select Case Thousands

            Case 1
                Result = Result & "ألف"

            Case 2
                Result = Result & "ألفان"

            Case 3 To 10
                Result = Result & ConvertHundreds(Thousands) & " آلاف"

            Case Else
                Result = Result & ConvertHundreds(Thousands) & " ألف"

        End Select

        Num = Rest

    End If

    ' ================= Hundreds =================
    If Num > 0 Then
        If Result <> "" Then
            Result = Result & " و "
        End If

        Result = Result & ConvertHundreds(Num)

    End If

    ConvertNumber = Result

End Function

Private Function ConvertHundreds(ByVal Num As Long) As String
    Dim Result As String

    Dim H As Long
    Dim T As Long

    H = Num \ 100
    T = Num Mod 100

    ' ===== Hundreds =====
    If H > 0 Then
        Result = Hundreds(H)
    End If

    ' ===== Tens & Ones =====
    If T > 0 Then

        If Result <> "" Then
            Result = Result & " و "
        End If
        If T < 20 Then
            Result = Result & Ones(T)
        Else
            Dim TensPart As Long
            Dim OnesPart As Long
            TensPart = T \ 10
            OnesPart = T Mod 10
            If OnesPart > 0 Then
                Result = Result & Ones(OnesPart) & " و "
            End If
            Result = Result & Tens(TensPart)
        End If
    End If
    ConvertHundreds = Result
End Function

Public Function TAFQEET(ByVal N As Double) As String
    'Use as a function in Excel
    TAFQEET = AmountToArabicWords(N)
End Function