كيف احول الارقام الى كتابة

بواسطةفوري

طريقة تحويل الارقام الى كتابة

لا يحتوي Excel على وظيفة لتحويل الأرقام إلى حروف إنجليزية، ولكن يمكنك إضافة هذه الإمكانية عن طريق لصق رمز وظيفة SpellNumber التالي في وحدة VBA (Visual Basic for Applications)، وتتيح لك هذه الوظيفة تحويل المبالغ بالدولار والسنت إلى كلمات باستخدام صيغة ،ويمكن أن يكون هذا مفيدًا جدًا إذا كنت تستخدم

Excel

كقالب لطباعة الشيكات.

ويمكنك تحويل الأرقام إلى حروف عن طريق استخدام كود برمجي داخل  برنامج الإكسل، ويمكنك كتابة وتنفيذ هذا الكود باستخدام الخطوات التالية: الخطوات التالية:

أولًا: لعرض علامة التبويب developer

  • اذهب لقائمة ملف file.
  • اضغط على خيارات options
  • من النافذة المنبثقة التي ستظهر أمامك اضغط على تخصيص الشريط ” customise ribbon”
  • ابحث عن المطور developer ، ثم ضع علامة (√) داخل المربع المجاور لها.
  • اضغط على ok.

ثانيًا: بعد إظهار علامة التبويب المطور قم بالخطوات التالية لتحويل الأرقام إلى حروف:

اضغط على علامة التبويب المطور  ” developer”.

  • اذهب إلى visual basic واضغط عليه.
  • اضغط على insert.
  • اختر model، وسوف تنبثق لك نافذة.
  • قم بنسخ الكود التالي ولصقه في النافذة.

    Option Explicit

    ‘Main Function

    Function SpellNumber(ByVal MyNumber)

    Dim Dollars, Cents, Temp

    Dim DecimalPlace, Count

    ReDim Place(9) As String

    Place(2) = ” Thousand ”

    Place(3) = ” Million ”

    Place(4) = ” Billion ”

    Place(5) = ” Trillion ”

    ‘ String representation of amount.

    MyNumber = Trim(Str(MyNumber))

    ‘ Position of decimal place 0 if none.

    DecimalPlace = InStr(MyNumber, “.”)

    ‘ Convert cents and set MyNumber to dollar amount.

    If DecimalPlace > 0 Then

    Cents = GetTens(Left(Mid(MyNumber, DecimalPlace + 1) & _ “00”, 2))

    MyNumber = Trim(Left(MyNumber, DecimalPlace – 1))

    End If

    Count = 1

    Do While MyNumber <> “”

    Temp = GetHundreds(Right(MyNumber, 3))

    If Temp <> “” Then Dollars = Temp & Place(Count) & Dollars

    If Len(MyNumber) > 3 Then

    MyNumber = Left(MyNumber, Len(MyNumber) – 3)

    Else

    MyNumber = “”

    End If

    Count = Count + 1

    Loop

    Select Case Dollars

    Case “”

    Dollars = “No Dollars”

    Case “One”

    Dollars = “One Dollar”

    Case Else

    Dollars = Dollars & ” Dollars”

    End Select

    Select Case Cents

    Case “”

    Cents = ” and No Cents”

    Case “One”

    Cents = ” and One Cent”

    Case Else

    Cents = ” and ” & Cents & ” Cents”

    End Select

    SpellNumber = Dollars & Cents

    End Function

    ‘ Converts a number from 100-999 into text

    Function GetHundreds(ByVal MyNumber)

    Dim Result As String

    If Val(MyNumber) = 0 Then Exit Function

    MyNumber = Right(“000” & MyNumber, 3)

    ‘ Convert the hundreds place.

    If Mid(MyNumber, 1, 1) <> “0” Then

    Result = GetDigit(Mid(MyNumber, 1, 1)) & ” Hundred ”

    End If

    ‘ Convert the tens and ones place.

    If Mid(MyNumber, 2, 1) <> “0” Then

    Result = Result & GetTens(Mid(MyNumber, 2))

    Else

    Result = Result & GetDigit(Mid(MyNumber, 3))

    End If

    GetHundreds = Result

    End Function

    ‘ Converts a number from 10 to 99 into text.

    Function GetTens(TensText)

    Dim Result As String

    Result = “” ‘ Null out the temporary function value.

    If Val(Left(TensText, 1)) = 1 Then ‘ If value between 10-19…

    Select Case Val(TensText)

    Case 10: Result = “Ten”

    Case 11: Result = “Eleven”

    Case 12: Result = “Twelve”

    Case 13: Result = “Thirteen”

    Case 14: Result = “Fourteen”

    Case 15: Result = “Fifteen”

    Case 16: Result = “Sixteen”

    Case 17: Result = “Seventeen”

    Case 18: Result = “Eighteen”

    Case 19: Result = “Nineteen”

    Case Else

    End Select

    Else ‘ If value between 20-99…

    Select Case Val(Left(TensText, 1))

    Case 2: Result = “Twenty ”

    Case 3: Result = “Thirty ”

    Case 4: Result = “Forty ”

    Case 5: Result = “Fifty ”

    Case 6: Result = “Sixty ”

    Case 7: Result = “Seventy ”

    Case 8: Result = “Eighty ”

    Case 9: Result = “Ninety ”

    Case Else

    End Select

    Result = Result & GetDigit _

    (Right(TensText, 1)) ‘ Retrieve ones place.

    End If

    GetTens = Result

    End Function

    ‘ Converts a number from 1 to 9 into text.

    Function GetDigit(Digit)

    Select Case Val(Digit)

    Case 1: GetDigit = “One”

    Case 2: GetDigit = “Two”

    Case 3: GetDigit = “Three”

    Case 4: GetDigit = “Four”

    Case 5: GetDigit = “Five”

    Case 6: GetDigit = “Six”

    Case 7: GetDigit = “Seven”

    Case 8: GetDigit = “Eight”

    Case 9: GetDigit = “Nine”

    Case Else: GetDigit = “”

    End Select

    End Function

  • اضغط حفظ، واختر تنسيق excel macro enabled template

ثالثًا: الآن بعد أن قمت بنسخ الكود قم بتفعيل الدالة داخل البرنامج.

  • اذهب الجدول الذي تريد تحويل الأرقام إلى كتابة فيه.
  • وفي الخانة المراد الكتابة بها قم بكتابة =()SpellNumber (اجعل = على اليسار).
  • ثم بين القوسين اضغط على علامة الدالة ƒ.
  • سيظهر لك مربع حوار function arguments.
  • في خانة number ضع الخلية التي بها الرقمالمراد تحويله
  • في خانة ال main currency ضع العملة مثلا دولار.
  • وفي الsub currency ضع العملة سنت.
  • اضغط وستجد أن الأرقام ستتحول إلى حروف.
  • بعد ذلك قم بسحب الدالة بالسهم حتى أخر الجدول، وستجد أن كل الأرقام التي ستضيفها في خانة الأرقام تتحول إلى كتابة.
  • ويمكنك أيضًا كتابة القيمة يدويًا مثل = SpellNumber (22.50)، ثم اضغط على زر enter ليتحول الرقم إلى حروف. [1]

تحويل الأرقام إلى حروف باللغة العربية Excel

اتبع نفس الخطوات السابقة لتحويل الأرقام إلى حروف عربية، لكن فقط قم بنسخ الكود التالي وطباعته داخل وحدة الماكرو بدلًا من الكود السابق:

Function NumberToText(Number As Double, MainCurrency As String, SubCurrency As String)

Dim Array1(0 To 9) As String

Dim Array2(0 To 9) As String

Dim Array3(0 To 9) As String

Dim MyNumber As String

Dim GetNumber As String

Dim ReadNumber As String

Dim My100 As String

Dim My10 As String

Dim My1 As String

Dim My11 As String

Dim My12 As String

Dim GetText As String

Dim Billion As String

Dim Million As String

Dim Thousand As String

Dim Hundred As String

Dim Fraction As String

Dim MyAnd As String

Dim I As Integer

Dim ReMark As String

If Number > 999999999999.99 Then Exit Function

If Number < 0 Then

Number = Number * -1

ReMark = “سالب ”

End If

If Number = 0 Then

NumberToText = “صفر”

Exit Function

End If

MyAnd = ” و”

Array1(0) = “”

Array1(1) = “مائة”

Array1(2) = “مائتان”

Array1(3) = “ثلاثمائة”

Array1(4) = “أربعمائة”

Array1(5) = “خمسمائة”

Array1(6) = “ستمائة”

Array1(7) = “سبعمائة”

Array1(8) = “ثمانمائة”

Array1(9) = “تسعمائة”

Array2(0) = “”

Array2(1) = ” عشر”

Array2(2) = “عشرون”

Array2(3) = “ثلاثون”

Array2(4) = “أربعون”

Array2(5) = “خمسون”

Array2(6) = “ستون”

Array2(7) = “سبعون”

Array2(8) = “ثمانون”

Array2(9) = “تسعون”

Array3(0) = “”

Array3(1) = “واحد”

Array3(2) = “اثنان”

Array3(3) = “ثلاثة”

Array3(4) = “أربعة”

Array3(5) = “خمسة”

Array3(6) = “ستة”

Array3(7) = “سبعة”

Array3(8) = “ثمانية”

Array3(9) = “تسعة”

GetNumber = Format(Number, “000000000000.00”)

I = 0

Do While I < 15

If I < 12 Then

MyNumber = Mid$(GetNumber, I + 1, 3)

Else

MyNumber = “0” + Mid$(GetNumber, I + 2, 2)

End If

If (Mid$(MyNumber, 1, 3)) > 0 Then

ReadNumber = Mid$(MyNumber, 1, 1)

My100 = Array1(ReadNumber)

ReadNumber = Mid$(MyNumber, 3, 1)

My1 = Array3(ReadNumber)

ReadNumber = Mid$(MyNumber, 2, 1)

My10 = Array2(ReadNumber)

If Mid$(MyNumber, 2, 2) = 11 Then My11 = “إحدى عشرة”

If Mid$(MyNumber, 2, 2) = 12 Then My12 = “إثنى عشرة”

If Mid$(MyNumber, 2, 2) = 10 Then My10 = “عشرة”

If ((Mid$(MyNumber, 1, 1)) > 0) And ((Mid$(MyNumber, 2, 2)) > 0) Then My100 = My100 + MyAnd

If ((Mid$(MyNumber, 3, 1)) > 0) And ((Mid$(MyNumber, 2, 1)) > 1) Then My1 = My1 + MyAnd

GetText = My100 + My1 + My10

If ((Mid$(MyNumber, 3, 1)) = 1) And ((Mid$(MyNumber, 2, 1)) = 1) Then

GetText = My100 + My11

If ((Mid$(MyNumber, 1, 1)) = 0) Then GetText = My11

End If

If ((Mid$(MyNumber, 3, 1)) = 2) And ((Mid$(MyNumber, 2, 1)) = 1) Then

GetText = My100 + My12

If ((Mid$(MyNumber, 1, 1)) = 0) Then GetText = My12

End If

If (I = 0) And (GetText <> “”) Then

If ((Mid$(MyNumber, 1, 3)) > 10) Then

Billion = GetText + ” مليار”

Else

Billion = GetText + ” مليارات”

If ((Mid$(MyNumber, 1, 3)) = 2) Then Billion = ” مليار”

If ((Mid$(MyNumber, 1, 3)) = 2) Then Billion = ” مليارن”

End If

End If

If (I = 3) And (GetText <> “”) Then

If ((Mid$(MyNumber, 1, 3)) > 10) Then

Million = GetText + ” مليون”

Else

Million = GetText + ” ملايين”

If ((Mid$(MyNumber, 1, 3)) = 1) Then Million = ” مليون”

If ((Mid$(MyNumber, 1, 3)) = 2) Then Million = ” مليونان”

End If

End If

If (I = 6) And (GetText <> “”) Then

If ((Mid$(MyNumber, 1, 3)) > 10) Then

Thousand = GetText + ” ألف”

Else

Thousand = GetText + ” ألاف”

If ((Mid$(MyNumber, 3, 1)) = 1) Then Thousand = ” ألف”

If ((Mid$(MyNumber, 3, 1)) = 2) Then Thousand = ” ألفان”

End If

End If

If (I = 9) And (GetText <> “”) Then Hundred = GetText

If (I = 12) And (GetText <> “”) Then Fraction = GetText

End If

I = I + 3

Loop

If (Billion <> “”) Then

If (Million <> “”) Or (Thousand <> “”) Or (Hundred <> “”) Then Billion = Billion + MyAnd

End If

If (Million <> “”) Then

If (Thousand <> “”) Or (Hundred <> “”) Then Million = Million + MyAnd

End If

If (Thousand <> “”) Then

If (Hundred <> “”) Then Thousand = Thousand + MyAnd

End If

If Fraction <> “” Then

If (Billion <> “”) Or (Million <> “”) Or (Thousand <> “”) Or (Hundred <> “”) Then

NumberToText = ReMark + Billion + Million + Thousand + Hundred + ” ” + MainCurrency + MyAnd + Fraction + ” ” + SubCurrency

Else

NumberToText = ReMark + Fraction + ” ” + SubCurrency

End If

Else

NumberToText = ReMark + Billion + Million + Thousand + Hundred + ” ” + MainCurrency

End If

End Function

  • وفي الخانة المراد الكتابة بها قم بكتابة اسم الدالة =()NumberToText

تحويل الارقام إلى حروف باللغة العربية Word

لتحويل الأرقام لحروف في الورد قم بكتابة الرقم المراد تحويله  على سبيل المثال 125، ثم قم بتحديده .

اضغط على زر ctrl + f9، ليظهر أمامك قوسين {}

ثم اكتب الصيغة التالية داخل القوسين

{=125\*cardtext}

اضغط على الصيغة التي قمت بكتابتها  بالزر الأيمن للفأرة ثم اختر تبديل رموز الحقول.

لتتحول الأرقام إلى كتابة.

ملاحظة : هذه الطريقة قد لا تعمل مع كل نسخ الوورد. [2]