مثلا 1 الأوّل 22 الثّاني والعشرون وهكذا .....
Option Explicit
Function Order_Salim(cel#)
Dim degree$, i%, My_num1%, My_num2%
Dim aHad$, Asharat$
If Not IsNumeric(cel) Then Order_Salim = "N/A": Exit Function
If cel = 100 Then
Order_Salim = "المائة": Exit Function
End If
If cel > 100 Then
Order_Salim = "too Big Number": Exit Function
End If
cel = Int(Abs(cel))
Dim deg1$, deg2$, deg3$, deg4$, deg5$, deg6$, deg7$, deg8$, deg9$, deg10$
deg1 = "الأوّل": deg2 = "الثّاني": deg3 = "الثّالث": deg4 = "الرّابع"
deg5 = "الخامس": deg6 = "السّادس": deg7 = "السّابع": deg8 = "الثّامن": deg9 = "التّاسع": deg10 = "العاشر"
Dim deg01$, deg02$, deg03$, deg04$, deg05$, deg06$, deg07$, deg08$, deg09$
deg01 = "عشر": deg02 = "والعشرون": deg03 = "والثّلاثون": deg04 = "والأربعون": deg05 = "والخمسون"
deg06 = "والستون": deg07 = "والسّبعون": deg08 = "والثّمانون": deg09 = "والتّسعون"
If cel < 11 Then
Select Case cel
Case Is = 1: degree = deg1
Case Is = 2: degree = deg2
Case Is = 3: degree = deg3
Case Is = 4: degree = deg4
Case Is = 5: degree = deg5
Case Is = 6: degree = deg6
Case Is = 7: degree = deg7
Case Is = 8: degree = deg8
Case Is = 9: degree = deg9
Case Is = 10: degree = deg10
End Select
Order_Salim = degree: Exit Function
Else
My_num1 = Mid(cel, 2, 1)
'===========================
Select Case My_num1
'=======================
Case Is = 1: aHad = "الحادي"
Case Is = 2: aHad = deg2
Case Is = 3: aHad = deg3
Case Is = 4: aHad = deg4
Case Is = 5: aHad = deg5
Case Is = 6: aHad = deg6
Case Is = 7: aHad = deg7
Case Is = 8: aHad = deg8
Case Is = 9: aHad = deg9
End Select
'======================
My_num2 = Mid(cel, 1, 1)
Select Case My_num2
Case Is = 1: Asharat = deg01
Case Is = 2: Asharat = deg02
Case Is = 3: Asharat = deg03
Case Is = 4: Asharat = deg04
Case Is = 5: Asharat = deg05
Case Is = 6: Asharat = deg06
Case Is = 7: Asharat = deg07
Case Is = 8: Asharat = deg08
Case Is = 9: Asharat = deg09
End Select
If My_num1 = 0 Then
Order_Salim = Right(aHad & " " & Asharat, Len(aHad & " " & Asharat) - 2)
Else
Order_Salim = aHad & " " & Asharat
End If
End If
End Function
[3]
المراتب بين واحد و مئة
تحميل محتوى الموضوع
عرض نسخة صالحة للطباعة
أرسل هذا الموضوع إلى صديق
