تفقيط الأرقام باللغة العربية Excel 2010

عملية التفقيط أو تحويل الأرقام إلى كلمات هي من العمليات الأساسية اليوم، لأنها تمثل درع حماية وأمان ضد التزوير أو التلاعب بالأرقام والأعداد الحسابية التي هي أساس كافة المعاملات المالية إليك شرح طريقة تفقيط الأرقام باللغة العربية Excel 2010.

معنى التفقيط :

قبل البدء في شرح كيفية تفقيط الأرقام باللغة العربية Excel 2010 يجب اولاً أن نعرف ما هو تفقيط الارقام، يقصد بالتفقيط عملية كتابة الأرقام الحسابية أو الأعداد بالحروف والكلمات، بالإضافة إلى عبارة (فقط لا غير) لمنع التلاعب بالأرقام والتي يمكن تزويرها بسهولة بإضافة أصفار إلى يمينها. تُعد عملية التفقيط ضرورية اليوم لأنها توفر ضماناً أساسياً لحماية الأوراق والمستندات المالية والشيكات من التزوير، وبالتالي تضمن لكل شخص الحصول على حقه.

أهمية التفقيط :

تُعتبر عملية التفقيط مهمة لأنها:

• تحمي من التزوير والتلاعب بالأرقام.
• توفر أمانًا إضافيًا في المعاملات المالية.
• تضمن دقة وصحة البيانات المالية.

تفقيط الأرقام باللغة العربية Excel 2010

عملية تحويل الأرقام إلى حروف، أو ما يُعرف بعملية التفقيط، نحتاجها في العديد من المواقف العملية مثل:

• عند إعداد فاتورة وكتابة إجمالي مبلغ الفاتورة بالأرقام والحروف.
• عند كتابة شيك وذكر مبلغ الشيك بالأرقام والحروف.

برنامج Excel يحتوي على العديد من الدوال التي تُسهِّل العمل، مثل دالة SUM لحساب المجموع، ودالة COUNT لحساب عدد الخلايا التي تحتوي على أرقام، ودالة MAX لحساب أكبر قيمة، وغيرها.

لكن للأسف، لا توجد دالة جاهزة في Excel لتحويل الأرقام إلى حروف. لذا، يجب إنشاء هذه الدالة بنفسك بكتابة كود VBA، وهو ما سنتعلمه في هذا الدرس.

هيا بنا نشرح خطوات تفقيط الأرقام باللغة العربية Excel 2010.

خطوات إنشاء دالة لتفقيط الأرقام باللغة العربية Excel 2010:

لكي تقوم بإنشاء دالة تفقيط الأرقام باللغة العربية Excel 2010 كل ما عليك فعله هو :

1. افتح ملف Excel جديد.
2. اذهب إلى التبويب “Developer” واضغط على “Visual Basic”.
3. ستفتح نافذة “Microsoft Visual Basic”. اضغط بزر الماوس الأيمن على اسم المشروع.
4. ستظهر قائمة مختصرة، قف على الخيار “Insert” ومن القائمة الفرعية اضغط على “Module” لإضافة وحدة برمجية جديدة.
5. سيتم إضافة وحدة برمجية جديدة باسم “Module1”.

في نافذة كود “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

باتباع هذه الخطوات، يمكنك إنشاء دالة تفقيط الأرقام باللغة العربية Excel 2010 لتحويل الأرقام إلى حروف واستخدامها في عملياتك المالية والإدارية بسهولة.

في الكود السابق، قمنا بإنشاء دالة مخصصة باسم NumberToText التي تأخذ المعاملات التالية:

• number: الرقم
• MainCurrency: العملة الرئيسية
• SubCurrency: العملة الفرعية

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

مثال 1:

مثال 2:

بهذا اكون شرح لك كل ما يخص تفقيط الأرقام باللغة العربية Excel 2010.

ملحوظة: احفظ الملف بصيغة Excel Macro-Enabled Workbook (بامتداد .xlsm) لأنه يحتوي على كود VBA.