اذهب إلى المحتوى

تحويل من ارقام الي حروف باكسل

سامي مقازي
 مشاركة

Recommended Posts

  • بعد 1 شهر...
  • بعد 1 شهر...
aliatwa عضو جديد

aliatwa

بتاريخ:
بتاريخ:

الاخ الفاضل

نسخت لك كود تحويل الارقام واتمنى ان ينسخ فى الرد كما هو

كما ان لدى ملف اكسل به ما تريد ولكن لا اعرف كيف ارسله لك

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

انشئ حساب جديد أو قم بتسجيل دخولك لتتمكن من إضافة تعليق جديد

يجب ان تكون عضوا لدينا لتتمكن من التعليق

انشئ حساب جديد

سجل حسابك الجديد لدينا في الموقع بمنتهي السهوله .

سجل حساب جديد

تسجيل دخول

هل تمتلك حساب بالفعل؟ سجل دخولك من هنا.

سجل دخولك الان
 مشاركة
عودة لقائمة الموضوعات
×
×
  • أضف...