أقسام الوصول السريع (مربع البحث)

طريقة تفقيط الأرقام في Excel.

تحويل الأرقام إلى حروف (تفقيط الأرقام)

طريقة التفقيط في الاكسل
تفقيط اكسل

عملية تحويل الأرقام إلى حروف أو ما يسميها البعض عملية التفقيط نحتاجها في أغلب أعمالنا مثل : عندما نقوم بعمل فاتورة فإننا نحتاج الى مبلغ الفاتورة بالأرقام والحروف عند كتابة شيك لعميل كذلك نحتاج إلى كتابة المبلغ بالأرقام والحروف. هناك دوال كثيرة في برنامج Excel وتسهل الكثير على المستخدم فهناك دالة الـ SUM لحساب المجموع , و دالة COUNT لحساب عدد الخلايا التي تحتوى على أرقام , و دالة MAX لحساب أكبر قيمة .... وهكذا

وعلى الرغم من كثرة الدوال الموجودة في الـــ Excel إلا أنه يفتقر الى دالة جاهزة تقوم بعملية التفقيط لذا عليك عمل هذه الدالة - كود VBA - لعملية التفقيط وهذا ما يستدعي شرح هذا الموضوع:

خطوات عملية التفقيط.

  •  قم بفتح برنامج الــ EXCEL 
  • اضعط على تبويب Developer
  • اضغط على Visual Basic
سيتم فتح الـــ Microsoft Visual Basic
  • نقوم بالضغط على الزر الأيمن للماوس على اسم المشروع وستظهر قائمة مختصرة نقوم باختيار الــ Insert
  • القائمة الفرعية نقوم بالضعط على الــــ Module لإضافة وحدة برمجية جديدة.
سيتم إضافة وحدة برمجية جديدة باسم Module1
تفقيط الأرقام في الاكسل
تفقيط الأرقام في Excel.

فى نافذة كود Module1 نقوم بنسخ ولصق الكود التالي :

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

number : الرقم

MainCurrency : العملة الرئيسية

SubCurrency : العملة الفرعية

يمكنك الأن استخدام دالة NumberToText مثل أى دالة فى برنامج Excel كما سنرى فى الأمثلة التالية .



تعليقات