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

بسم الله الرحمن الرحيم الاخ الفاضل طلب تحويل الارقام الى حروف على حد علمى يتم v.b الفاجول بيسك وله اكواد

الف شكر موضوع رائع

من فضلك اين الموضوع