تحويل الأرقام إلى حروف باللغة الانجليزية في برنامج مايكروسفت Excel

 تحويل الأرقام إلى حروف  باللغة الانجليزية في برنامج مايكروسفت Excel

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

لا يوجد دوال في برنامج مايكروسفت Excel تقوم بتحويل الأرقام إلى حروف ,في هذه التدوين سنقوم  ببرمجة دالة بشكل خاص من خلال لغة VBA في الاكسيل.

نقوم بملف جديد , ثم نذهب إلى التبويب Developer واضغط على Visual Basic.

في حالة لم نجد علامة التبويب Developer ظاهرة عندنا كل ما علينا فعله هو توجيه سهم الماوس الى علامات التبويب في الاعلى ثم الضغط على الزر الأيمن في الماوس بعد ذالك نضغط على customize ribbon ونقوم بوضع علامة على Developer .

سيتم فتح نافذة Microsoft Visual Basic for Applications ومن القائمة المختصرة نضغط على Insert ثم Module

تم اضافة وحدة ماكرو أو برمجية جديدة اسمها Module1 يمكنك تغيير اسمها إذا أردت , للمزيد من دروس البرمجة في الاكسيل , اضغط هنا .

في الوحدة البرمجية الجديدة Module1 نقوم بنسخ ولصق الكود التالي داخلها .

Function NumberToTextEN(ByVal MyNumber, MainCurrency As String, SubCurrency As String)

Dim Number1, Number2, Temp

Dim DecimalPlace, Count

ReDim Place(9) As String

Place(2) = " Thousand "

Place(3) = " Million "

Place(4) = " Billion "

Place(5) = " Trillion "

MyNumber = Trim(Str(MyNumber))

DecimalPlace = InStr(MyNumber, ".")

If DecimalPlace > 0 Then

Number2 = 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 Number1 = Temp & Place(Count) & Number1

If Len(MyNumber) > 3 Then

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

Else

MyNumber = ""

End If

Count = Count + 1

Loop

Select Case Number1

Case ""

Number1 = "No " & MainCurrency

Case Else

Number1 = Number1 & " " & MainCurrency

End Select

Select Case Number2

Case ""

Number2 = ""

Case Else

Number2 = " and " & Number2 & " " & SubCurrency

End Select

NumberToTextEN = Number1 & Number2

End Function



Function GetHundreds(ByVal MyNumber)

Dim Result As String

If Val(MyNumber) = 0 Then Exit Function

MyNumber = Right("000" & MyNumber, 3)

If Mid(MyNumber, 1, 1) <> "0" Then

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

End If


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



Function GetTens(TensText)

Dim Result As String

Result = ""

If Val(Left(TensText, 1)) = 1 Then

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

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))

End If

GetTens = Result

End Function



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

في الكود أعلاه قمنا بعمل دالة مخصصة اسمها NumberToTextEN تأخد الثلاثة معاملات التالية :

MyNumber : الرقم

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

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

الأن يمكننا استخدام دالة NumberToTextEN مثل أى دالة جاهزة كما سنرى في الأمثلة التالية .

مثال 1 :

مثال 2 :

مثال 3 :

بالنسبة لعملية الحفظ فلابد من حفظ الملف بنوع Excel Macro-Enabled Workbook لأنه يحتوى على كود VBA