الأحبة الكرام 

كيف يمكن تحويل الرفم داخل اللإكسل إلى أحرف باللغة العربية وتميزها كما تريد

تفتح برنامج الإكسل 2010 ثم تضغط على مفتاحي alt+f11 يفتح لك نافذة الكود كما بالشكل التالي

ثم بعد ذالك نضغط من قائمة insert    نختار  module تظهر نافذة الكود كما في الشكل التالي

ثم نقوم بعمل نسخ لهذا الكود 

Private Function ChangeToDigits1(temp As String) As String
If temp = "0" Then
ChangeToDigits1 = ""
GoTo finish
End If
If temp = "1" Then
ChangeToDigits1 = "واحد"
GoTo finish
End If
If temp = "2" Then
ChangeToDigits1 = "اثنان"
GoTo finish
End If
If temp = "3" Then
ChangeToDigits1 = "ثلاثة"
GoTo finish
End If
If temp = "4" Then
ChangeToDigits1 = "اربعة"
GoTo finish
End If
If temp = "5" Then
ChangeToDigits1 = "خمسة"
GoTo finish
End If
If temp = "6" Then
ChangeToDigits1 = "ستة"
GoTo finish
End If

If temp = "7" Then
ChangeToDigits1 = "سبعة"
GoTo finish
End If

If temp = "8" Then
ChangeToDigits1 = "ثمانية"
GoTo finish
End If
If temp = "9" Then
ChangeToDigits1 = "تسعة"
GoTo finish
End If
finish:
End Function

Private Function ChangeToDigits2(temp As String) As String
Dim digit1 As String
Dim digit2 As String
Dim between As String
digit2 = Left(temp, 1)
digit1 = Right(temp, 1)
If digit2 = "1" Then
ChangeToDigits2 = "عشر"
GoTo finish
End If

If digit2 = "2" Then
ChangeToDigits2 = "عشرون"
GoTo finish
End If

If digit2 = "3" Then
ChangeToDigits2 = "ثلاثون"
GoTo finish
End If
If digit2 = "4" Then
ChangeToDigits2 = "اربعون"
GoTo finish
End If
If digit2 = "5" Then
ChangeToDigits2 = "خمسون"
GoTo finish
End If
If digit2 = "6" Then
ChangeToDigits2 = "ستون"
GoTo finish
End If
If digit2 = "7" Then
ChangeToDigits2 = "سبعون"
GoTo finish
End If
If digit2 = "8" Then
ChangeToDigits2 = "ثمانون"
GoTo finish
End If
If digit2 = "9" Then
ChangeToDigits2 = "تسعون"
GoTo finish
End If

finish:
If digit1 = "0" Then
digit1 = ""
between = ""
Else
If digit2 = "1" Then
between = " "
digit1 = ChangeToDigits1(digit1)
Else
between = " و "
digit1 = ChangeToDigits1(digit1)
End If
End If

If digit2 = "0" Then between = ""

ChangeToDigits2 = digit1 & between & ChangeToDigits2
If temp = "00" Then ChangeToDigits2 = ""
If temp = "11" Then ChangeToDigits2 = "احدى عشر"
If temp = "12" Then ChangeToDigits2 = "اثنا عشر"

If temp = "10" Then ChangeToDigits2 = "عشرة"
End Function

Private Function ChangeToDigits3(temp As String) As String
Dim between As String
Dim handred As String
Dim first As String
Dim second As String
handred = " مائة"
first = ChangeToDigits1(Left(temp, 1))
second = ChangeToDigits2(Right(temp, 2))
If second <> "" Then between = " و " Else between = ""
If first = "" Then
between = ""
handred = ""
End If
If first = "واحد" Then first = ""
If first = "اثنان" Then
first = ""
handred = " مئتان"
End If
ChangeToDigits3 = first & handred & between & second
If temp = "000" Then ChangeToDigits3 = ""
End Function

Private Function ChangeToDigits4(temp As String) As String
Dim between As String
Dim thousand As String
Dim first As String
Dim second As String
thousand = " آلاف"
first = ChangeToDigits1(Left(temp, 1))
second = ChangeToDigits3(Right(temp, 3))
If second <> "" Then between = " و " Else between = ""

If first = "" Then
between = ""
thousand = ""
End If

If first = "واحد" Then
first = ""
thousand = "الف"
End If
If first = "اثنان" Then
first = ""
thousand = "الفا"
End If
ChangeToDigits4 = first & thousand & between & second
If temp = "0000" Then ChangeToDigits4 = ""
End Function

Private Function ChangeToDigits5(temp As String) As String
Dim between As String
Dim thousand As String
Dim first As String
Dim second As String
thousand = " الف"
first = ChangeToDigits2(Left(temp, 2))
second = ChangeToDigits3(Right(temp, 3))
If second <> "" Then between = " و " Else between = ""
If first = "" Then
between = ""
thousand = ""
End If

If first = "واحد" Then
first = ""
thousand = "الف"
End If
If first = "اثنان" Then
first = ""
thousand = "الفا"
End If
ChangeToDigits5 = first & thousand & between & second
If temp = "00000" Then ChangeToDigits5 = ""
End Function

Private Function ChangeToDigits6(temp As String) As String
Dim between As String
Dim thousand As String
Dim first As String
Dim second As String
thousand = " الف"
first = ChangeToDigits3(Left(temp, 3))
second = ChangeToDigits3(Right(temp, 3))
If second <> "" Then between = " و " Else between = ""

If first = "" Then
between = ""
thousand = ""
End If

If first = "واحد" Then
first = ""
thousand = "الف"
End If
If first = "اثنان" Then
first = ""
thousand = "الفا"
End If
ChangeToDigits6 = first & thousand & between & second
If temp = "000000" Then ChangeToDigits6 = ""
End Function
Private Function ChangeToDigits7(temp As String) As String
Dim between As String
Dim Million As String
Dim first As String
Dim second As String
Million = "ملايين"
first = ChangeToDigits1(Left(temp, 1))
second = ChangeToDigits6(Right(temp, 6))
If second <> "" Then between = " و " Else between = ""

If first = "" Then
between = ""
Million = ""
End If

If first = "واحد" Then
first = ""
Million = "مليون"
End If
If first = "اثنان" Then
first = ""
Million = "مليونا"
End If
ChangeToDigits7 = first & Million & between & second

End Function
Private Function ChangeToDigits8(temp As String) As String
Dim between As String
Dim Million As String
Dim first As String
Dim second As String
Million = " مليون "
first = ChangeToDigits2(Left(temp, 2))
second = ChangeToDigits6(Right(temp, 6))
If second <> "" Then between = " و " Else between = ""

If first = "" Then
between = ""
Million = ""
End If

If first = "واحد" Then
first = ""
Million = " مليون "
End If
If first = "اثنان" Then
first = ""
Million = "مليونا"
End If
ChangeToDigits8 = first & Million & between & second

End Function

Private Function ChangeToDigits9(temp As String) As String
Dim between As String
Dim Million As String
Dim first As String
Dim second As String
Million = " مليون "
first = ChangeToDigits3(Left(temp, 3))
second = ChangeToDigits6(Right(temp, 6))
If second <> "" Then between = " و " Else between = ""

If first = "" Then
between = ""
Million = ""
End If

If first = "واحد" Then
first = ""
Million = " مليون "
End If
If first = "اثنان" Then
first = ""
Million = "مليونا"
End If
ChangeToDigits9 = first & Million & between & second

End Function

Public Function ChangeThisNumber(Allnumber As String) As String

Dim temp As String
Dim backed As String
Dim backed2 As String
Dim Length As Integer
Dim bigcur, smallcur As String
Dim intnum As String
Dim floatnum As String
Dim i As Integer
Dim found As Boolean

Allnumber = Trim(Allnumber)
If Not IsNumeric(Allnumber) Then
ChangeThisNumber = "خطــــــــأ فــــــي الادخــــــــــال"
Exit Function
End If

i = 1
Do While i <> Len(Allnumber) + 1
If Mid(Allnumber, i, 1) <> "." Then
intnum = intnum & Mid(Allnumber, i, 1)
Else
found = True
GoTo Float
End If
i = i + 1
Loop

Float:
If found Then
i = i + 1
Do While i <> Len(Allnumber) + 1
floatnum = floatnum & Mid(Allnumber, i, 1)
i = i + 1
Loop
End If

'temp = txtNameA.Text
temp = intnum
Length = Len(temp)

If Length = 1 Then backed = ChangeToDigits1(temp)
If Length = 2 Then backed = ChangeToDigits2(temp)
If Length = 3 Then backed = ChangeToDigits3(temp)
If Length = 4 Then backed = ChangeToDigits4(temp)
If Length = 5 Then backed = ChangeToDigits5(temp)
If Length = 6 Then backed = ChangeToDigits6(temp)
If Length = 7 Then backed = ChangeToDigits7(temp)
If Length = 8 Then backed = ChangeToDigits8(temp)
If Length = 9 Then backed = ChangeToDigits9(temp)

temp = floatnum
Length = Len(temp)

If Length = 1 Then backed2 = ChangeToDigits1(temp)
If Length = 2 Then backed2 = ChangeToDigits2(temp)
If Length = 3 Then backed2 = ChangeToDigits3(temp)
If Length = 4 Then backed2 = ChangeToDigits4(temp)
If Length = 5 Then backed2 = ChangeToDigits5(temp)
If Length = 6 Then backed2 = ChangeToDigits6(temp)
If Length = 7 Then backed2 = ChangeToDigits7(temp)
If Length = 8 Then backed2 = ChangeToDigits8(temp)
If Length = 9 Then backed2 = ChangeToDigits9(temp)

smallcur = StrSmallNameCurrency
bigcur = StrLargeNameCurrency

Dim Filse As String
Dim between As String
Dim jd As String

between = " و "

If backed <> "" Then
jd = " " & bigcur & " "
Else
jd = ""
between = ""
End If

If backed2 <> "" Then
Filse = " " & smallcur & " " & “من عشرة”
Else
Filse = ""
between = ""
End If
ChangeThisNumber = backed & jd & between & backed2 & Filse & " درجة"
End Function

Top of Form

ثم تقوم بعمل لصق وحفظ وجرب الأرقام إل أنت عيزها 

ماذا لو أردت تغيير التميز من درجة إلى جنيه أو كيلو متر أو أي تميز أخرل أنظر للسطر الأخير وكلمة الدرجة المكتوبة بالون الأحمر وغيرهها الأي تمير عيزة 

الكود مجرب وشغال 

وأي مشاكل اتصل برقم 01000580966