JavaScript is not enabled!...Please enable javascript in your browser

جافا سكريبت غير ممكن! ... الرجاء تفعيل الجافا سكريبت في متصفحك.

-->
الصفحة الرئيسية

عالم الاوفيس | تحويل الارقام الى حروف وكلمات بالعربية (تفقيط الارقام ) فى الاكسل

بسم الله الرحمن الرحيم 

اكسيل | تحويل الارقام الى حروف باللغة العربية (تفقيط الارقام )

اهلا بكم متابعى موقع عالم الاوفيس



درس اليوم سوف نتناول فية دالة تفقيط الارقام 

ماذا يعنى تفقيط الارقام ؟

عملية تحويل الارقام الى حروف فى الاكسل او مايسميها معظم مستخدمى الاكسل بتفقيط الارقام نحتاجها فى كثير من اعمالنا على الاكسيل  مثلا

  • عند عمل فاتورة مبيعات لابد من اجمالى للمبلغ مفقط اى مثلا 2900 ج(فقط وقدرة الفان وتسعمائة جنيها لاغير )
  • عند عمل ايصال امانة ويجب فية تفقيط المبلغ لبالارقام والحروف 
  • عند عمل ايصال استلام نقدية 
  • عند عمل شيك وكتابة مبلغ الشيك بالارقام والحروف
يحتوى برنامج الاكسل Excelعلى العديد من الدوال التى تستخدم لحساب اجمالى المبالغ مثل الدالة Sum ولكن للاسف لايوجد دالة لتفقيط الارقام او تحويل الارقام الى حروف او كلمات فى برنامج Excel

لذلك وجب علينا عمل هذة الدالة بانفسنا او ادراجها فى برنامج الاكسل Excel من خلال الخطوات التالية 

  1. نفتح ملف Excel جديد ونذهب الى تبويب المطور او Developer ونفتح نافذة visual basic


 


2- يتم فتح نافذة Microsoft Visual basic  نقوم بالضغط بالزر الايمن للفارة وعمل ادراج وحدة نمطية جديدة Insert Modal


3- يتم ادراج وحدة نمطية او موديول جديد باسم Module 1 نقوم بنشخ هذا الكود ولصقة فى هذا الموديول 



الكود

Function NoToTxt2(TheNo As Double, MyCur As String, MySubCur As String) As String
Dim MyArry1(0 To 9) As String
Dim MyArry2(0 To 9) As String
Dim MyArry3(0 To 9) As String
Dim Myno As String
Dim GetNo As String
Dim RdNo As String
Dim My100 As String
Dim My10 As String
Dim My1 As String
Dim My11 As String
Dim My12 As String
Dim GetTxt As String
Dim Mybillion As String
Dim MyMillion As String
Dim MyThou As String
Dim MyHun As String
Dim MyFraction As String
Dim MyAnd As String
Dim I As Integer
Dim ReMark As String


If TheNo > 999999999999.999 Then Exit Function

If TheNo < 0 Then
TheNo = TheNo * -1
ReMark = "فقط "
Else
ReMark = "فقط "
End If

If TheNo = 0 Then
NoToTxt2 = " "
Exit Function
End If

MyAnd = " و"
MyArry1(0) = ""
MyArry1(1) = "مائة"
MyArry1(2) = "مائتان"
MyArry1(3) = "ثلاثمائة"
MyArry1(4) = "أربعمائة"
MyArry1(5) = "خمسمائة"
MyArry1(6) = "ستمائة"
MyArry1(7) = "سبعمائة"
MyArry1(8) = "ثمانمائة"
MyArry1(9) = "تسعمائة"

MyArry2(0) = ""
MyArry2(1) = " عشر"
MyArry2(2) = "عشرون"
MyArry2(3) = "ثلاثون"
MyArry2(4) = "أربعون"
MyArry2(5) = "خمسون"
MyArry2(6) = "ستون"
MyArry2(7) = "سبعون"
MyArry2(8) = "ثمانون"
MyArry2(9) = "تسعون"

MyArry3(0) = ""
MyArry3(1) = "واحد"
MyArry3(2) = "اثنان"
MyArry3(3) = "ثلاثة"
MyArry3(4) = "أربعة"
MyArry3(5) = "خمسة"
MyArry3(6) = "ستة"
MyArry3(7) = "سبعة"
MyArry3(8) = "ثمانية"
MyArry3(9) = "تسعة"
'======================
GetNo = Round(TheNo, 3)
GetNo = Format(TheNo, "000000000000.000")

I = 0
'===============
Do While I < 16

If I < 12 Then
Myno = Mid$(GetNo, I + 1, 3)
Else
Myno = Mid$(GetNo, I + 2, 3) + "0" ' "0" + Mid$(GetNo, I + 2, 2)
End If

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

RdNo = Mid$(Myno, 1, 1)
My100 = MyArry1(RdNo)
RdNo = Mid$(Myno, 3, 1)
My1 = MyArry3(RdNo)
RdNo = Mid$(Myno, 2, 1)
My10 = MyArry2(RdNo)

If Mid$(Myno, 2, 2) = 11 Then My11 = "إحدى عشر"
If Mid$(Myno, 2, 2) = 12 Then My12 = "إثنى عشر"
If Mid$(Myno, 2, 2) = 10 Then My10 = "عشرة"

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

GetTxt = My100 + My1 + My10

If ((Mid$(Myno, 3, 1)) = 1) And ((Mid$(Myno, 2, 1)) = 1) Then
GetTxt = My100 + My11
If ((Mid$(Myno, 1, 1)) = 0) Then GetTxt = My11
End If

If ((Mid$(Myno, 3, 1)) = 2) And ((Mid$(Myno, 2, 1)) = 1) Then
GetTxt = My100 + My12
If ((Mid$(Myno, 1, 1)) = 0) Then GetTxt = My12
End If

If (I = 0) And (GetTxt <> "") Then
If ((Mid$(Myno, 1, 3)) > 10) Then
Mybillion = GetTxt + " مليار"
Else
Mybillion = GetTxt + " مليارات"
If ((Mid$(Myno, 1, 3)) = 2) Then Mybillion = " مليار"
If ((Mid$(Myno, 1, 3)) = 2) Then Mybillion = " ملياران"
End If
End If

If (I = 3) And (GetTxt <> "") Then

If ((Mid$(Myno, 1, 3)) > 10) Then
MyMillion = GetTxt + " مليون"
Else
MyMillion = GetTxt + " ملايين"
If ((Mid$(Myno, 1, 3)) = 1) Then MyMillion = " مليون"
If ((Mid$(Myno, 1, 3)) = 2) Then MyMillion = " مليونان"
End If
End If

If (I = 6) And (GetTxt <> "") Then
If ((Mid$(Myno, 1, 3)) > 10) Then
MyThou = GetTxt + " ألف"
Else
MyThou = GetTxt + " آلاف"
If ((Mid$(Myno, 3, 1)) = 1) Then MyThou = " ألف"
If ((Mid$(Myno, 3, 1)) = 2) Then MyThou = " ألفان"
End If
End If

If (I = 9) And (GetTxt <> "") Then MyHun = GetTxt
If (I = 12) And (GetTxt <> "") Then MyFraction = GetTxt
End If

I = I + 3
Loop
'============================
If (Mybillion <> "") Then
If (MyMillion <> "") Or (MyThou <> "") Or (MyHun <> "") Then Mybillion = Mybillion + MyAnd
End If

If (MyMillion <> "") Then
If (MyThou <> "") Or (MyHun <> "") Then MyMillion = MyMillion + MyAnd
End If

If (MyThou <> "") Then
If (MyHun <> "") Then MyThou = MyThou + MyAnd
End If

If MyFraction <> "" Then
If (Mybillion <> "") Or (MyMillion <> "") Or (MyThou <> "") Or (MyHun <> "") Then
NoToTxt2 = ReMark + Mybillion + MyMillion + MyThou + MyHun + " " + MyCur + MyAnd + MyFraction + " " + MySubCur
Else
NoToTxt2 = ReMark + MyFraction + " " + MySubCur
End If
Else
NoToTxt2 = ReMark + Mybillion + MyMillion + MyThou + MyHun + " " + MyCur
End If

End Function


بعد لصق هذا الكود نكون قد ادرجنا دالة تفقيط الارقام فى الاكسل والتى اسمها NoToTxt2
تعمل كاى دالة موجودة فى ملف الاكسل 

ويكون طريقة عملها كما فى الشكل التالى 


ثم بعد ذلك نقوم بحفظ الملف بصيغة Enable Macro حتى يتم حفظ الكود البرمجى للدالة

لمتابعة اكثر يرجى مشاهدة شرح الفيديو



وبهذا نكون قد انهتينا من شرح درس التفقيط وتحويل الارقام الى كلمات فى الاكسيل  


الاسمبريد إلكترونيرسالة