هديتي للمنتدى الارقام العربية

تقصد: تفقيط

أخي ASMSA

مجهود رائع وكبير يمكن أن يستفيد منه الكثير من المبرمجين للمنظومات المتعلقة بالمحاسبة وأحياناً يكون الفرد فيه في أمس الحاجة لهذه الوظيفة ومستعد يدفع الغالي والرخيص في سبيل الحصول عليها وها هي هنا مجاناً هدية منك

لك الشكر بالنيابة عن كل من نسخها وأستفاد منها في العمل أو المعرفة أو التعليم ولا ينقصها سواء شئ بسيط بالنسبة لك وهو الشرح المفصل لتسلسل برمجتها حتى يتم حفظها مستقبلا ومحاولة كتابتها بدلا من نسخها ولصقها كما هي دون أن نعرف خفايا متغيراتها وأوامرها

السلام عليكم

مشكور أخى ASMSA

هل لى بمثال وافى يشرح كيفية إستخدام هذا الكود ؟

لقد جربته فى مثالى ولكن يوجد أخطاء عندى فى تعريف المتغيرات أرجو ان اكون على خطأ !

أتمنى الافادة

تحياتى

كود متعوب عيه بالتوفيق إن شاء الله

مشكور علي المجهود الرائع.

شيء رائع

شكرا جزيلا اخي الكريم...

أخونا الحبيب ASMSA :

أول شيء الله يجزيك ألف ألف خير ، ويكتب لك الأجر وينفع بك .

ما شاء الله عليك ، والله إن دل هذا الشيء فإنما يدل على حبك لنشر العلم والرقي بأمتك ، وصراحة عندما قرأت العنوان وفتحت الموضوع عجبني جداً ، وعلمت أنه متعوب كتير عليه ، ولكن أسأل الله أن ييفتح عليك ويوفقك ، ويكثر من أمثالك ، لأنو أكتر الشباب إذا تعبوا هيك تعب ، يبخلوا على إخوانون ، وياليت كل الشباب متلك .

وإلى الأمام أخي

والله يوفقك .

على فكرة أنا جربت الكود وزبط ، بس في إيرور ما فهمت عليه : وهو في الكود التالي : حيث يوضع تحت Left خط أزرق .

اقتباس

X = Left(X, Len(X) - 2)

وفي قائمة الأخطائ بيكتوبلي :

Public Property Left() As Integer' has no parameters and its return type cannot be indexed.

وإذا حذفت الدالة Left ، يتنفذ البرنامج طبيعياً .

ولك خالص دعواتي والله يوفقك

تحياتي للكل واشكر كل من اهتم بالموضوع واعتذر عن التآخر عن الرد بسبب انشغالي

الكود مكتوب بالفيجوال بيسك 6 ولاني حاليا لاملك اصدارة منه وبسبب انشغالي ايضا لايمكنني الاطلاع على الخطأ لكن على اية حال اذا لم يسبقني احد لذلك ساعيد كتابته باستخدام الفيجوال بيسك دوت.

أخي جزاك الله خير الجزاء

هل يمكنني استخدامها في برنامج الأكسل حيث انه لدي فاتوره تعمل على الأكسل والمبلغ يجب ان اكتبه يدوياً

اذا امكن ذلك

فكيف الطريقة

أسئل الله لك ولوالديك الجنة يارب يارب

code hunter كتب:

أخي mohamd2020

عند حذفك للداله LEFT فان البرنامج يعمل ولكن هناك اخطاء مثلا اعطه اربع ارقام مثل 1234 ستكون النتيجه "ألف"

او 3234 ستكون النتيجه "اربعة آلاف" ولا يكمل الباقي

وكذلك عندما تتعدى عدد الارقام 9 مثلا 123456789 سوف ينطقها كما يلي

مائة و ثلاثة عشرين مليون و اربع مائة و ستة و خمسين الف و سبع مائة و تسعة و ثمانين

ستجده لم يكتب حرف "و" بعد كلمة "وثلاثة" ثاني كلمه

نريد الحل من المبرمج وله الف شكر وتحيه

عزيزي (محمد2020) بخصوص الارقام التي ذكرت انه لاينطقها كما يجب انا عملت التالي بناء على طلب الاخ (المركزي) حولت الكود الى الاكسل لانه يستخدم ايضا الفيجوال بيسك 6 الذي كتب به الكود فاعطاني نتيجة صحية مائة بالمائة وهي كالتالي :

123.456.789

مائة و ثلاثة عشرين مليون و اربع مائة و ستة و خمسين الف و سبع مائة و تسعة و ثمانين

فالرجاء التاكد من صحة كتابة للكود ولك خالص التحية

تحية مني للكل واشكر لهم جهدهم المبذول للاطلاع على الكود .. وبخصوص عمل الكود في الاكسل فهو يمكن لصقه ووضعه بمنطقة الماكرو واستخدامه فوراً وقد اجريت عليه التعديل اللازم لاستخدامه بالاكسل وكذلك اصلاح الحرف الناقص الذي تسبب في الخطأ الذي ذكره بعض الاخوة في نطق الارقام في خانة المليون .. ولهم مرة اخرى اخلص تحية والكود المعدل كالتالي:

[v-

oo

أخواني انا غير ملم بعمليات البرمجة فتحت ماكرو جديد وسويت لصق ولكن بعد ذالك لم استطع أن اكمل ..

ياليت كرماً منكم الطريقة بالتفصيل حتى استفيد ويستفيد غيري منها ولكم جزيك الشكر ولإمتنان

وبارك الله في جهودكم

وشكراً لك اخي ASMSA شكراً خاصاً على ما تبذله من جهود

وجعلك في عليين مع النبيين والشهداء والصالحين ...

cdcase كتب:

السلام عليكم

مشكور أخى ASMSA

هل لى بمثال وافى يشرح كيفية إستخدام هذا الكود ؟

لقد جربته فى مثالى ولكن يوجد أخطاء عندى فى تعريف المتغيرات أرجو ان اكون على خطأ !

أتمنى الافادة

تحياتى

للرفع

تحياتي لك اخي المركزي اليك عزيزي الكود بملف مرفق بناء على رغبتك وباعلى الملف ستجد شرح لطريق الاستفادة من الكود بالاكسل او بالوورد .. وانتمنا لي ولك التوفيق

بخصوص مداخلتك عزيزي cdcase احب ان اشير الى ابسط مثال لاستخدام الكود هو عن طريق الاكسل لانه يعتمد لغة الفيجوال بيسك 6 لذلك ستجد من السهولة استخدام وتجربة الكود بهذا البرنامج... والكود موجود بالملف المرفق مع شرح لطريقة استخدامه بالاكسل والوورد .. وبخصوص الاخطاء في المتغييرات يجب التنبيه الى ان هناك فرق معروف للكل بين متغييرات الفيجوال بيسك 6 والفيجوال بيسك على منصة الدوت نت .. فارجوا التنبه الى هذه النقطة ....

واحب ان اشير الى انه تم تعديل الخطأ الذي كان موجود بالكود باول المشاركة حيث انه كان هناك حرف واحد ناقص بمنطقة المليون وذلك بسبب خطاء اثناء النسخ واللصق والكود يعمل مائة بالمائة ولتعديله لبيئة الدوت نت فكل المطلوب هو تعديل المتغييرات للتوافق مع تلك البئية .. ولكم مني اخلص تحية.

ToWordsArb.txt

هذا هو الكود بعد التعديل بعد اذن صاحب الكود

  Private Function ToWordsArb(ByVal Num As String) As String
		Dim S1 As String, S2 As String, S3 As String, Tmp As String, X As String
		Dim L As Integer, T As Integer, R As Integer, T_ As String
		Const S As String = " " : Const O As String = " و "
		T_ = "الاف"


		'Fill Array'''''''''''''''''''(1 to 9)'''''''''''''''''''''
		Dim AN(9) As String 'Data for conversion
		AN(1) = "واحد" : AN(2) = "اثنان" : AN(3) = "ثلاثة"
		AN(4) = "اربعة" : AN(5) = "خمسة" : AN(6) = "ستة"
		AN(7) = "سبعة" : AN(8) = "ثمانية" : AN(9) = "تسعة"
		''''''''''''''''''''(11 to 19 )'''''''''''''''''''''''''''''
		Dim BN(9) As String
		BN(0) = "عشرة"
		BN(1) = "احد عشر" : BN(2) = "اثنا عشر" : BN(3) = "ثلاثة عشر"
		BN(4) = "اربع عشر" : BN(5) = "خمسة عشر" : BN(6) = "ستة عشر"
		BN(7) = "سبعة عشر" : BN(8) = "ثمانية عشر" : BN(9) = "تسعة عشر"
		''''''''''''''''''''(10 to 90)'''''''''''''''''''''''''''''''''''
		Dim CN(9) As String
		CN(1) = "عشرة" : CN(2) = "عشرين" : CN(3) = "ثلاثين"
		CN(4) = "اربعين" : CN(5) = "خمسين" : CN(6) = "ستين"
		CN(7) = "سبعين" : CN(8) = "ثمانين" : CN(9) = "تسعين"
		''''''''''''''''''''(100 to 900)'''''''''''''''''''''''''''''''''''
		Dim DN(9) As String
		DN(1) = "مائة" : DN(2) = "مائتين" : DN(3) = "ثلاث مائة"
		DN(4) = "اربع مائة" : DN(5) = "خمس مائة" : DN(6) = "ست مائة"
		DN(7) = "سبع مائة" : DN(8) = "ثمان مائة" : DN(9) = "تسع مائة"
		'ZEROs''''''''''''''''''''''''''''''
		AN(0) = "" : BN(0) = "عشرة" : CN(0) = "" : DN(0) = ""
		'Make redey''''''''''''''''''''''''''''''

		L = Len(Num)

		'''''''''''''''''''''''''''''''''Check Start: ''''''''''''''''''''''''''''''''''''''''''''
		''ALL BY ORDER :'''''''''''''''''''''''''''''

		Dim W As Collection, C As Integer, MM As String
		W = New Collection
		'Split numbers to array
		For T = L To 1 Step -1
			MM = Mid(CStr(Num), T, 1)
			If IsNumeric(MM) Then W.Add(MM)
		Next T
		'Exit if it Zero'''''''''''''''''''''''''''''''''''''''''''''''''''''''''
		Num = Replace(Num, "|", "") : If Val(Num) = 0 Then X = "صفر" : GoTo Ex '''
		C = W.Count : L = C 'Very Important								  '''
		'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

		'1 Check''1 to 9
		If L = 1 Then X = AN(Val(Num)) : GoTo Ex

		'2 Check'11-12-13....To: 19
		If L = 2 Then If Val(W.Item(2)) = 1 Then _
		X = BN(Val(W.Item(1))) : GoTo Ex

		'2 Check'10-20-30....To: 90
		If L = 2 Then If Val(W.Item(1)) = 0 Then _
		X = CN(Val(W.Item(1))) : GoTo Ex

		'3 Check'From 21 ....To: 90
		If L = 2 Then X = AN(Val(W.Item(1))) & O & CN(Val(W.Item(2))) : GoTo Ex

Re_Check:
		'3 Check' The Tow Frist Numbers of Large number:
		If Val(W.Item(2)) = "1" Then 'Elvenths(BN)
			X = BN(Val(Val(W.Item(1))))
			X = X
		ElseIf Val(W.Item(1)) = "0" Then 'Tointeth(CN)
			X = CN(Val(Val(W.Item(2))))
		Else
			X = AN(Val(W.Item(1))) & O & CN(Val(W.Item(2)))  'From 21-67 ....To: 90
		End If

		X = Zeros(W, X, 2)

		'4 Check ' 12-31-41... to end'''

		If L > 2 Then 'Hundreds(DN)
			X = DN(Val(W.Item(3))) & O & X 'Hundreds & Numbers
			If W.Item(1) = "0" And W.Item(2) = "0" Then X = DN(Val(W.Item(3))) 'Hundreds & Zeros

			X = Zeros(W, X, 3)
		End If
		'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
		If L = 4 Then ' Thawsend(1,000)''4 Numbers'''''''''''''''''''''''''''''''

			If Val(W.Item(4)) = 1 Then
				Tmp = "الف"
			ElseIf Val(W.Item(4)) = 2 Then
				Tmp = "الفين"
			Else
				Tmp = "الاف"
			End If

			If Tmp = "الاف" Then X = AN(Val(W.Item(4))) & S & Tmp & O & X Else X = Tmp & O & X 'Thawsend & Numbers

			If W(2) = "0" & W(3) = "0" & W(4) = "0" Then _
			If Tmp = "الاف" Then X = AN(Val(W.Item(1))) & S & Tmp Else X = Tmp 'Thawsend & Zeros

			X = Zeros(W, X, 4)
		End If
		'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
		'If L > 4 And L < 8 Then '10 Thawsend(10,000)''5 Numbers'''''''''''''''''''''''''''''''
		If L > 4 Then ''___ OPEN IF ______________________________________________(L > 4)

TenThawsend:  '10 Thawsend(10,000)''5 Numbers'''''''''''''''''''''''''''''''
			Tmp = ""
			If W(5) = "0" Then GoTo HoundredsThawsend 'Jump

			If Val(W.Item(5)) = 1 Then
				Tmp = "عشرة الاف"
			ElseIf Val(W.Item(5)) = 2 Then
				Tmp = "عشرين الف"
			End If


			If W(4) = "0" Then '10.000
				If Val(W.Item(5)) = 1 Or Val(W.Item(5)) = 2 Then X = Tmp & O & X Else _
				T_ = "الف" : X = CN(Val(W(5))) & S & T_ & O & X
			Else '11.000
				T_ = "الف"
				If W(5) = "1" Then X = BN(Val(W(4))) & S & T_ & O & X
				If W(5) <> "1" Then X = AN(Val(W(4))) & O & CN(Val(W(5))) & S & T_ & O & X
			End If

			If L = 5 Then GoTo Ex '100 Thawsend(100,000)''6 Numbers''''''''''''''''''''''''''''''
HoundredsThawsend:

			If W(6) = "0" Then GoTo Mileons 'Jump
			X = Zeros(W, X, 5)

			Tmp = "الف"

			If W(5) = "0" And W(4) = "0" Then
				X = DN(Val(W(6))) & S & Tmp & O & X
			Else
				If W(5) = 0 Then
					If Val(W(6)) > 2 Then Tmp = "الاف"
					If Val(W(5)) = 0 Then If Val(W(4)) > 2 Then Tmp = "الاف" Else Tmp = "الف"
					X = DN(Val(W(6))) & O & AN(Val(W(4))) & S & Tmp & O & X 'tx here
				Else
					X = DN(Val(W(6))) & O & X
				End If
			End If
			X = Replace(X, "مائتين الف", "مئتي الف")
			X = Replace(X, " الف الف ", " الف ")

			If L < 7 Then GoTo Ex 'Milon(1000,000)''7 numbers'''''''''''''''''''''''''''''''
Mileons:

			If Val(W.Item(7)) < 1 Then GoTo TenMileons 'Jump
			If L > 7 Then If Val(W.Item(8)) <> 0 Then GoTo TenMileons 'Jump
			If L > 8 Then If Val(W(9)) <> 0 Then GoTo TenMileons 'Jump

			Tmp = "ملاين"


			If Val(W.Item(7)) = 1 Then
				Tmp = "مليون"
			ElseIf Val(W.Item(7)) = 2 Then
				Tmp = "مليونين"
			End If

			X = Zeros(W, X, 6)

			If Val(W.Item(7)) > 2 Then X = AN(Val(W(7))) & S & Tmp & O & X Else X = Tmp & O & X

			If L < 8 Then GoTo Ex 'Milon(10,000,000)''8 numbers'''''''''''''''''''''''''''''''
TenMileons:
			If L > 8 Then If Val(W(9)) <> 0 Or Val(W(8)) < 1 Then GoTo HoundredsMileons 'Jump

			If Val(W(8)) = 1 Then Tmp = "ملاين" Else Tmp = "مليون"

			X = Zeros(W, X, 6)
			X = Zeros(W, X, 7)

			If Val(W(8)) = 1 Then 'Tenth Mileons:10,000,000
				If Val(W(7)) = 0 Then X = CN(Val(W(8))) & S & Tmp & O & X Else _
				Tmp = "مليون" : X = BN(Val(W(7))) & S & Tmp & O & X 'Elventh Mileons
			Else
				If Val(W(7)) = 0 Then X = CN(Val(W(8))) & S & Tmp & O & X Else _
				 X = AN(Val(W(7))) & O & CN(Val(W(8))) & S & Tmp & O & X '12,000,000
			End If

			If L < 9 Then GoTo Ex 'Milon(100,000,000)''9 numbers'''''''''''''''''''''''''''''''
HoundredsMileons:
			If L > 9 And Val(W(9)) < 1 Then GoTo Bileon

			Tmp = "مليون"
			X = Zeros(W, X, 8)

			If Val(W(7)) = 0 And Val(W(8)) = 0 Then	'100,000,000
				X = DN(Val(W(9))) & S & Tmp & O & X 'Puer Houndreds Of Mileons
			Else '110,000,000
				'1- Houndreds Of Mileons & Elvenths : ..2- Else :Houndreds Of Mileons & Frist numbers
				If Val(W(8)) = 1 Then X = DN(Val(W(9))) & O & BN(Val(W(7))) & S & Tmp & O & X Else _
				X = DN(Val(W(9))) & O & AN(Val(W(7))) & S & CN(Val(W(8))) & S & Tmp & O & X
			End If
			X = Replace(X, "مائتين مليون", "مئتي مليون")

			If L < 10 Then GoTo Ex 'Bileon(1,000,000,000)''10 numbers'''''''''''''''''''''''''''''''
Bileon:

			If Val(W.Item(10)) < 1 Then GoTo Ten_Of_Bileons 'Jump
			If L > 10 Then If Val(W.Item(11)) <> 0 Then GoTo Ten_Of_Bileons 'Jump
			If L > 11 Then If Val(W(12)) <> 0 Then GoTo Ten_Of_Bileons 'Jump


			Tmp = "بلاين"

			If Val(W.Item(10)) = 1 Then
				Tmp = "بليون"
			ElseIf Val(W.Item(10)) = 2 Then
				Tmp = "بليونين"
			End If

			X = Zeros(W, X, 9)

			If Val(W.Item(10)) > 2 Then X = AN(Val(W(10))) & S & Tmp & O & X Else X = Tmp & O & X

			If L < 11 Then GoTo Ex 'Bileon(10,000,000,000)''11 numbers'''''''''''''''''''''''''''''''
Ten_Of_Bileons:

			If L > 11 Then If Val(W(12)) <> 0 Or Val(W(11)) < 1 Then GoTo Houndred_Of_Bileons 'Jump

			If Val(W(11)) = 1 Then Tmp = "بلاين" Else Tmp = "بليون"

			X = Zeros(W, X, 11)

			If Val(W(11)) = 1 Then 'Tenth Bileons:10,000,000,000
				If Val(W(10)) = 0 Then X = CN(Val(W(11))) & S & Tmp & O & X Else _
				Tmp = "بليون" : X = BN(Val(W(10))) & S & Tmp & O & X 'Elventh Bileons
			Else
				If Val(W(10)) = 0 Then X = CN(Val(W(11))) & S & Tmp & O & X Else _
				 X = AN(Val(W(10))) & O & CN(Val(W(11))) & S & Tmp & O & X '12,000,000,000
			End If

			If L < 12 Then GoTo Ex 'Bileon(100,000,000,000)''12 numbers'''''''''''''''''''''''''''''''
Houndred_Of_Bileons:
			If L > 12 And Val(W(12)) < 1 Then GoTo Trlion

			Tmp = "بليون"
			X = Zeros(W, X, 12)

			If Val(W(10)) = 0 And Val(W(11)) = 0 Then	'100,000,000,000
				X = DN(Val(W(12))) & S & Tmp & O & X 'Puer Houndreds Of Bileons
			Else '110,000,000,000
				'1- Houndreds Of Bileons & Elvenths : ..2- Else :Houndreds Of Bileons & Frist numbers
				If Val(W(11)) = 1 Then X = DN(Val(W(12))) & O & BN(Val(W(10))) & S & Tmp & O & X Else _
				X = DN(Val(W(12))) & O & AN(Val(W(10))) & S & CN(Val(W(11))) & S & Tmp & O & X
			End If

			X = Replace(X, "مائتين بليون", "مئتي بليون")

			If L < 13 Then GoTo Ex 'Trlion(1,000,000,000,000)''13 numbers'''''''''''''''''''''''''''''''
Trlion:

			If Val(W.Item(13)) < 1 Then GoTo Ten_Of_Trlions 'Jump
			If L > 13 Then If Val(W.Item(14)) <> 0 Then GoTo Ten_Of_Trlions 'Jump
			If L > 14 Then If Val(W.Item(15)) <> 0 Then GoTo Ten_Of_Trlions 'Jump


			Tmp = "تريلونات"

			If Val(W.Item(13)) = 1 Then
				Tmp = "ترليون"
			ElseIf Val(W.Item(13)) = 2 Then
				Tmp = "ترليونين"
			End If


			X = Zeros(W, X, 13)
			If Val(W.Item(13)) > 2 Then X = AN(Val(W(13))) & S & Tmp & O & X Else X = Tmp & O & X

			If L < 14 Then GoTo Ex 'Ten_Of_Trlions(10,000,000,000,000)''14 numbers'''''''''''''''''''''''''''''''
Ten_Of_Trlions:

			If L > 14 Then If Val(W(15)) <> 0 Or Val(W(14)) < 1 Then GoTo Houndreds_Of_Trlions 'Jump

			If Val(W(14)) = 1 Then Tmp = "تريلونات" Else Tmp = "ترليون"

			X = Zeros(W, X, 14)

			If Val(W(14)) = 1 Then 'Tenth Trlions:10,000,000,000,000
				If Val(W(13)) = 0 Then X = CN(Val(W(14))) & S & Tmp & O & X Else _
				Tmp = "ترليون" : X = BN(Val(W(13))) & S & Tmp & O & X 'Elventh Trlions
			Else
				If Val(W(13)) = 0 Then X = CN(Val(W(14))) & S & Tmp & O & X Else _
				 X = AN(Val(W(13))) & O & CN(Val(W(14))) & S & Tmp & O & X '12,000,000,000,000
			End If

			If L < 15 Then GoTo Ex 'Houndreds_Of_Trlions(100,000,000,000,000)''15 numbers'''''''''''''''''''''''''''''''
Houndreds_Of_Trlions:
			If L > 15 And Val(W(15)) < 1 Then GoTo Quadrillion

			Tmp = "ترليون"
			X = Zeros(W, X, 15)

			If Val(W(13)) = 0 And Val(W(14)) = 0 Then	'100,000,000,000,000
				X = DN(Val(W(15))) & S & Tmp & O & X 'Puer Houndreds Of Trlions
			Else '110,000,000,000,000
				'1- Houndreds Of Trlions & Elvenths : ..2- Else :Houndreds Of Trlions & Frist numbers
				If Val(W(14)) = 1 Then X = DN(Val(W(15))) & O & BN(Val(W(13))) & S & Tmp & O & X Else _
				X = DN(Val(W(15))) & O & AN(Val(W(13))) & S & CN(Val(W(14))) & S & Tmp & O & X
			End If

			X = Replace(X, "مائتين ترليون", "مئتي ترليون")

			If L < 16 Then GoTo Ex 'Quadrillion(1,000,000,000,000,000)''16 numbers'''''''''''''''''''''''''''''''
Quadrillion:

			If Val(W.Item(16)) < 1 Then GoTo Ten_Of_Quadrillions 'Jump
			If L > 16 Then If Val(W.Item(17)) <> 0 Then GoTo Ten_Of_Quadrillions 'Jump
			If L > 17 Then If Val(W.Item(18)) <> 0 Then GoTo Ten_Of_Quadrillions 'Jump


			Tmp = "كوادرليونات"

			If Val(W.Item(16)) = 1 Then
				Tmp = "كوادرليون"
			ElseIf Val(W.Item(16)) = 2 Then
				Tmp = "كوادرليونين"
			End If


			X = Zeros(W, X, 16)
			If Val(W.Item(16)) > 2 Then X = AN(Val(W(16))) & S & Tmp & O & X Else X = Tmp & O & X

			If L < 17 Then GoTo Ex 'Ten_Of_Quadrillions(10,000,000,000,000,000)''17 numbers'''''''''''''''''''''''''''''''
Ten_Of_Quadrillions:

			If L > 17 Then If Val(W(18)) <> 0 Or Val(W(17)) < 1 Then GoTo Houndreds_Of_Quadrillions 'Jump

			If Val(W(17)) = 1 Then Tmp = "كوادرليونات" Else Tmp = "كوادرليون"

			X = Zeros(W, X, 17)

			If Val(W(17)) = 1 Then 'Tenth Quadrillions
				If Val(W(16)) = 0 Then X = CN(Val(W(17))) & S & Tmp & O & X Else _
				Tmp = "كوادرليون" : X = BN(Val(W(16))) & S & Tmp & O & X 'Elventh Quadrillions
			Else
				If Val(W(16)) = 0 Then X = CN(Val(W(17))) & S & Tmp & O & X Else _
				 X = AN(Val(W(16))) & O & CN(Val(W(17))) & S & Tmp & O & X '12,000,000,000,000,000
			End If

			If L < 18 Then GoTo Ex 'Houndreds_Of_Quadrillions(100,000,000,000,000,000)''18 numbers'''''''''''''''''''''''''''''''
Houndreds_Of_Quadrillions:

			If L > 18 And Val(W(18)) < 1 Then GoTo Zlion

			Tmp = "كوادرليون"
			X = Zeros(W, X, 18)

			If Val(W(16)) = 0 And Val(W(17)) = 0 Then	'100,000,000,000
				X = DN(Val(W(18))) & S & Tmp & O & X 'Puer Houndreds Of Quadrillions
			Else '110,000,000,000
				'1- Houndreds Of Quadrillions & Elvenths : ..2- Else :Houndreds Of Quadrillions & Frist numbers
				If Val(W(17)) = 1 Then X = DN(Val(W(18))) & O & BN(Val(W(16))) & S & Tmp & O & X Else _
				X = DN(Val(W(18))) & O & AN(Val(W(16))) & S & CN(Val(W(17))) & S & Tmp & O & X
			End If

			X = Replace(X, "مائتين كوادرليون", "مئتي كوادرليون")

			If L < 19 Then GoTo Ex 'Houndreds_Of_Quadrillions(100,000,000,000,000,000)''18 numbers'''''''''''''''''''''''''''''''
Zlion:	  '[The end]'''Last Naming number
			X = "" : X = "زليون" & vbCrLf & "الزليون : رقم غير محدود يفوق التسميات المعروفة"

		End If ''___ CLOSE IF ______________________________________________(L > 4)
		'''''''''''''''''''''''''''''''''Check End: ''''''''''''''''''''''''''''''''''''''''''''''

Ex:
		W = Nothing
		X = Replace(X, O & O, O) ''Delte extra waws
		'delete last waw
		If Len(X) > 2 Then _
		If Mid(X, Len(X) - 2, 2) = " و" Or Mid(X, Len(X) - 2, 2) = "و " Then X = Mid(X, 1, Len(X) - 2)
		ToWordsArb = X
	End Function
	Private Function Zeros(ByVal Col As Collection, ByVal X As String, ByVal MAX As Integer) As String
		Dim T As Integer, I As Boolean
		If MAX < 1 Then Exit Function
		For T = 1 To Col.Count
			If Val(Col.Item(T)) <> 0 Then I = True : Exit For
			If T = MAX Then Exit For
		Next T
		If I Then Zeros = X Else Zeros = ""
	End Function

ولكن يتجاهل العلامة العشرية

ASMSA كتب:

بخصوص مداخلتك عزيزي cdcase احب ان اشير الى ابسط مثال لاستخدام الكود هو عن طريق الاكسل لانه يعتمد لغة الفيجوال بيسك 6 لذلك ستجد من السهولة استخدام وتجربة الكود بهذا البرنامج... والكود موجود بالملف المرفق مع شرح لطريقة استخدامه بالاكسل والوورد .. وبخصوص الاخطاء في المتغييرات يجب التنبيه الى ان هناك فرق معروف للكل بين متغييرات الفيجوال بيسك 6 والفيجوال بيسك على منصة الدوت نت .. فارجوا التنبه الى هذه النقطة ....

واحب ان اشير الى انه تم تعديل الخطأ الذي كان موجود بالكود باول المشاركة حيث انه كان هناك حرف واحد ناقص بمنطقة المليون وذلك بسبب خطاء اثناء النسخ واللصق والكود يعمل مائة بالمائة ولتعديله لبيئة الدوت نت فكل المطلوب هو تعديل المتغييرات للتوافق مع تلك البئية .. ولكم مني اخلص تحية.

جزاك الله عنا كل خير أخى العزيز ASMSA

====================================

أخى فى الله KARIMSOFT

مشكور جدا على تعبك وتعديلك للكود ليعمل على الدوت نت ولكن يوجد خطأ من بعد العدد (1000) إلى (9999) أرجو الافادة

واتمنى ان اكون على خطأ ؟

تحياتى

ASMSA كتب:

الآن الملف المرفق يحتوي الكود الخاص بالفيجوال بيسك 6 بملف نصي بصيغة اليونيكود ليتم اظهاره على كل الاجهزة بشكل صحيح وتم اضافة مزيد من التنقيح على الكود واستطيع ان اقول انه يعمل 100% والتجربة خير برهان ..وشكراً للكل..

ToWordsArb.txt

المرفقات التالية تحتوي ايضا على نفس الكود اعلاه لكن بعد اجراء تعديل بسيط ليمكن استخدام الكود بالنسخ الحديثة للفيجوال بيسك دوت نت مع العلم انه تم تحريره باستخدام الاصدار 2003 ..

ToWordsArb_CODE.zip

QuickExample.zip

ASMSA كتب:

المرفقات التالية تحتوي ايضا على نفس الكود اعلاه لكن بعد اجراء تعديل بسيط ليمكن استخدام الكود بالنسخ الحديثة للفيجوال بيسك دوت نت مع العلم انه تم تحريره باستخدام الاصدار 2003 ..

مرحبااااااااااا يبدو أنك لم ترى مشاركتى الاخيرة فى موضوعك

أخى مشكور جدا على تعبك وتعديلك للكود ليعمل على الدوت نت ولكن يوجد خطأن 1-من بعد العدد (1000) إلى (9999) 2- انه يتجاهل العلامة العشرية تمام ويكمل التفقيط على إنهم أرقام صحيحة

إنظر المرفقات

أرجو الافادة

واتمنى ان اكون على خطأ ؟

تحياتى

شكرا لك اخي cdcase على هذا التنبيه فعلاً كان هناك خطأ في منطقة الالف .. وتم اصلاح الكود بنجاح واحب ان اووكد انه يعمل الآن كما يرام وكما ذكرت ان الكود بمجهود خاص وعمل كما ترى معقد بعض الشي بسبب شموليته وكنت قد كتبته قبل 3 او 4 سنوات لكن لم يكن هناك وقت كاف لتجربة كل الاعداد عليه :blink: طبعاً لان ذلك مستحيل ( ومنطقة الالف هي بداية كانت قبل فريم الكود الموحد الذي عملته مثلا في منطقة الواحد مليون والواحد بليون ) وكانت بفريم اخر مختلف لكن حالياً عند مراجعتك للكود ستجد اني فقط وحدت مناطق الواحد الف والواحد مليون..الخ بكود متشابه .. وكانت النتيجة صحيحة مائة بالمائة ،،،

اما بخصوص العلامة العشرية فانا ارى انه من الافضل عدم التعامل معها لان في ذلك ارباك احيانا لانها قد تكتب لترتيب الارقام وليس كعلامة عشرية فالكود يتجاهل اي شى غير الارقام لضمان عمله بصورة صحيحة .. وشكر لك مرة آخرى... والكود التالي هو ايضا بعد اعادة التنقيح في الملفات المرفقة

QuickExample.zip

ToWordsArb_CODE.zip

ToWordsArb.txt

تم بحمد الله اضافة الجزء العشري

ToWordsArb_CODEnew.rar

وهذا الكود مرة اخرى بعد تنقيح الجزء المضاف من الزميل KARIMSOFT مشكورا الخاص بالعلامة العشرية و اسم العملة حيث قمت بعمل تنقيح عليه يضمن عدم وروود اخطاء و سلاسة الاستخدام

ToWordsArbCODE_New.rar

السلام عليكم و رحمة الله و بركاته

جزاك الله خيرا يا ASMSA

عمرو عيسي