شرح تحويل الارقام الى حروف في الاكسل بالتفصيل (التفقيط)

[@ahmedgharib9134]

شكرا لتعب حضرتك
جعله الله في ميزان حسناتك
شرح سلسل وبسيط
ولكل اخواتي اللي نزلوا الكود ومشتغلش وكانت النتيجه ؟؟؟?؟؟؟؟؟
دي مشكله عندك في لغه البرنامج
وممكن تفتح الكود notepad
ويشتغل معاك
وجزاكم الله خير

[@عبدالقادرعزالرجال-ض1ج]

ممكن شرح لموضوع الكود دا

[@aliterki9644]

بارك الله فيك ، من الجزائر لك تحياتي

[@WOS1962]

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

[@ishaqq732]

بعد تطبيق كافة الخطوات تظهر إشارات استفهام في الخلية

[@pcuser7398]

غير لغة البرنامج ولغة النظام الى العربية

[@sherifm.abdelsalam9105]

الشرح رائع وسلس وبسيط وواضح
جهد مميز ومشكور عليه اخى الكريم
جزاكم الله خيرا

[@rafatameen489]

الله يكتب اجرك يارب .

[@فكرىالأسودي]

جزاك الله خير الله يجزيك الجنة

[@aliazeez2020]

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

[@gazallgazall7652]

ارسل ملف سرح الفيدية
و

[@فرجمحمدالمنصوب]

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

[@moaazibrahim465]

السلام عليكم ورحمه الله وبركاته
بارك الله فيك وفي صحتك اللهم امين
ولكن اذا سمحتم ليا سؤال بارك الله فيكم انا كل ما اعمل المعادله واقفا الاكسيل وافتحه تاني المعادله تروح وتجي مكنها شبابيك

[@Al_Majalla_Althaqafia]

أهلا بك:
قم بحفظ ملف الاكسيل بامتداد
Excel macro enabled
.Xlsm

[@khadidjalamine3613]

طبقت كما فعلت خرجت لي كتابة غير مفهمومة ليست بالعربية

[@saouli2010]

شكرا لكم على المجهودات

[@houaribarca240]

عندي مشكلة لا يريد حفظ الكود بسبب loop ارجو المساعدة شكرا و جزاك الله استاذ على الشرح

[@geogarabet7279]

جهودكم مشكورة - شرح مبسط ومفيد. لكن لدي مشكلة حيث الكلمات تظهر بشكل ؟؟؟؟؟؟؟؟؟ فقط العملة الرئيسية والفرعية مضبوطة . لو سمحت ما هو الحل وهل أحد من الاخوة حدث معه نفس الشي شكرا للجميع

[@muhandmalik]

نفس السؤال

[@saryouce]

نفس المشكل , هل وجدت الحل؟

[@Al_Majalla_Althaqafia]

تفضل الحل في هذا الفيديو في الدقيقة ٥ و ١٠ ثوان:
ruclips.net/video/Ox3wor_h6is/видео.html

[@mahmoudtansawy1679]

تسلم اخي وشكرا علي مجهودك

[@malaknofal8869]

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

[@Al_Majalla_Althaqafia]

أهلا بك.

[@اياساياس-ط4ت]

شكرا، جزاك الله عنا كل خير

[@Al_Majalla_Althaqafia]

أهلا بك.

[@kingwaw]

يعطيك العافية
لكن عندك دالة تنفع مع نظام ماك لان النظام ما قبل كتابة الحروف بالعربي

[@pcuser7398]

جميل جدا اختصرت علي شغل اسبوع

[@eng.romanymamdouh9503]

شرح جميل ولكن بعد عمل الشرح اجد مشكلة فى قراءة الارقام حيث تأتي الكتابة بالعملة ورموز بدلا من الارقام فما الحل لهذه المشكلة

[@mahmoudadel35]

نفس المشكلة
تاتي باحرف غير مهومه

[@مصدقجاسمعلي]

يطلع علامة استفهام ؟؟؟؟؟

[@tarekgamal6902]

هل عند فتح شيت الاكسيل يتم عمل نفس الإجراءات حتى بعد الحفظ ؟؟

[@amiralshoq]

شكرا على الشرح لدي سؤال وهو كيف يمكنني أن أقوم بتحويل
الحروف K والتي تعبر عن ألف و M
التي تعبر عن مليون في خلايا أكسل مع خالص الشكر

[@RARA-mf5cm]

سيدي الفاضل عندما انسخ المعادلة وألصقها في النافذة المخصصة واضغط على حفظ تخرج لي عبارة (يتعذر حفظ المميزات التالية في المصنفات الغير مرتبطة بماكرون) ارجو الرد

[@mostafafox6360]

جزاكم الله خيراً

[@Nabadat_Technology]

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

[@AbubakerNsaiya]

بارك الله فيك و جزاك الله خير
ولكن العملة الفرعية تتكون من ثلاثة أرقام فهل لديك حل لهذه المشكلة وشكرا

[@user-ec8qg5cq1n]

عدل الكود وضيف اراي 4

[@raadalrashed9704]

بارك الله فيكم
لا تظهر معي المئات . مثلا 150.750 مائة وخمسون الف وخمسة وسبعون ؟ هل يجوز كتابة كيلو ومتر بدل العملة او طن غرام ؟

[@muathadmin7804]

شكرا لك

[@Al_Majalla_Althaqafia]

العفو.. أهلاً بك.

[@jijifiestajoumana1808]

هل يمكن إفادتنا كيف نغير لغة البرنامج ولغة النظام إلى العربية؟ لأن لدي السؤال ذاته . وشكرا سلفا

[@abdelrhmanelsayeh8171]

الف شكر لحضرتك ❤❤

[@mohamedfarouq1428]

رائع .. بارك الله فيك استاذنا العزيز

[@HaideralDaif]

جزاك الله خير

[@pinarn.8036]

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

[@Al_Majalla_Althaqafia]

أهلا بك

[@ناهضعهدعبدالمحسنناهض-ف4ق]

السلام عليكم
استاذ اريد يكتبلي الارقام بعد الفارزة 3 مراتب هذي الطريقة تكتب بس مرتبتين
اتمنى الرد

[@تاجالدينالهبة]

شكرا على هذه المعلومه
لكن هناك خلل وهو عند الخروج من الملف والدخول اليه مره اخرى وتعديل البيانات تتختفي الداله ولا يحفظ تلقائيا

[@Al_Majalla_Althaqafia]

أهلا بك..
لحل المشكلة يجب حفظ الملف بامتداد xlsm .

[@تاجالدينالهبة]

تم حفظه بامتداد xlsm

[@AhmedAlameer-h6g]

لو سمحت أين يمكن أن أجد الداله

[@muhammadsaadalfiqy7976]

جزاكم الله خيرًا على ما تقدمه لنا ، قمت بعمل ما قلته بالضبط لكن عند كتابة الأرقام بالخلية التي المفروض يظهر بها الحروف تظهر كالتالي " ???????? ????? ??????? جنيه ????? ????? قرشفقط لا غير" أرجو المساعدة لإصلاح هذا العيب

[@bluetech6966]

حتى انا

[@الصحابالمجهول]

حتى نا

[@جويداجيدا]

حتى انا أيضا بيظهر????????? ?????

[@NawafBaqrwan]

حتى انا ما الحل ؟

[@dalilraqmanya]

أعد كتابة الكود

[@ameratyat9639]

ممكن تعمل ملفلنا وتحفظه اكسل ونزله على جهاز ونشتغل مباشره عليه بزبط

[@عابدالشاعر-غ7خ]

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

[@mohamedtaha8881]

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

[@Al_Majalla_Althaqafia]

تفضل الحل في هذا الفيديو في الدقيقة ٥ و ١٠ ثوان:
ruclips.net/video/Ox3wor_h6is/видео.html

[@HassanAli-mw7hz]

بعد تطبيق جميع الخطوات يعمل ولكن لا يقرا المائات بعد العلامه العشريه مثال ١٥٠٠.٥٠٠ يقرأها الف وخمسمائة وخمسة

[@alaahashem6507]

انت عبقري

[@waleedshemes9706]

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

[@fahadalmunifi4364]

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

[@abdulkarimalgholi7505]

الف تحية وشكر لك . بارك الله فيك . عمل ممتاز ورائع.

[@wapro3021]

لك كل الاحترام

[@Ali_Ali_Ali495]

ياسيدي انا عملت مثل ماعملت انت بس ماتمت العملية..
اول حاجه بعد ما اقوم بعملية لصق الداله بعدين اعمل حفظ مايرضى بيطلع:-
يتعذر حفظ الميزات التالية في المصنفات غير المرتبطة بماكرو:
•مشروع VB
ايش الحل

[@Al_Majalla_Althaqafia]

احفظ الملف بنوع Excel Macro-Enabled Workbook (xlsm)..

[@anwarabdelmutalabmohamed2016]

وعليكم السلام شرحك جميل ولكن الحتة حقت الكود دي ماحصلنا الكود ولم نجده عشان كده ثمرة الفيديو كلها ضاعت علينا , ارجو النظر في هذا الامر ولك الاجر . شكرا

[@Al_Majalla_Althaqafia]

أخي الكريم الكود موجود في وصف الفيديو.

[@عابدالشاعر-غ7خ]

ممكن لو تكرمت شرح كيفية معرفة المكرر في عدة شيتات باللون. اقصد عندي ثلاثه شيتات بالاكسل كل شيت يحتوي قائمة اسماء واريد لو فيه اسم مكرر بواحد من الشيتات يظهر لي بلون بدون مااحتاج اجمع الاسماء بقائمة واحدة..

[@hatemtomy2402]

Conditional formatting > duplicates

[@kovanosman3924]

سلمت يداك و شكرا جزيلا
لكن كيف أجعل الكتابة تكون بالانكليزي
ارجو الرد

[@abdulrahmanal-abdulla8956]

بس موقع اكتبلنا اياه بالتعليقات الي سويت نسخ منه من عنده

[@Al_Majalla_Althaqafia]

أهلا بك.
الرابط موجود في الوصف أسفل الفيديو.

[@محمدزياد-ر1ب]

شكرا

[@ASDFGHJKLOSJJKS]

احسنت بارك الله فيك

[@ahmedali-c6n9d]

جزاكم الله كل خير -لكن اخى لا يظهر حرف حرفبية فقط علامات استفهام؟؟؟؟؟ ؟؟؟؟ ؟؟؟؟؟؟ جنيه--الخ

[@dr.ali94ahmed]

نفس المشكلة

[@lover_of_sillence5270]

جزاك الله خيراً على هذه المعلومات،
ولكن يطلع لي يتعذر حفظ الميزات التالية في المصنفات غير المرتبطة بماكرو: مشروع VB

[@shafihussein3452]

نفس الكلام يطلعلي وجدت حل لو بعدك

[@احمدمهدي-ض4ن5ض]

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

[@Al_Majalla_Althaqafia]

وعليكم السلام.
Shift+1

[@ishaqq732]

أفيدونا جزاكم الله خيرا

[@عابدالشاعر-غ7خ]

ليش مايشتغل الكود الا في ورقة واحدة وليس على الجميع. فقط حيث تم اللصق عليها

[@abdulkalk2006]

طبقت الشرح لكن تطلع النتيجة علامات استفهام

[@nasralhasnial-zaghena8468]

لو سمحتو من اين نحصل على دالة التخطيط ما قدرت احصل عليها

[@mohammaddari1998]

السلام عليكم. أنا كل ما سكر ملف الاكسل . ما عد يصير في حل للمشكلة وشكرا

[@Al_Majalla_Althaqafia]

يجب عليك حفظ الملف بنوع:
excel macro enabled workbook

[@karimaaziach2862]

اين هو الكود الذي يجب نسخه

[@TotaDonia]

فين الداله لو سمحت

[@veraid_]

لكن كيف أجعل هذا ثابتا في أي ملف أفتحه من الأكسل؟
فعندما أفتح ملفا جديدا لا تعمل فيه هذه الدالة التي ذكرتم، تعمل فقط في الملف الأصلي.

[@hamzazrekah4965]

لم تعمل عندي كان يظهر اشارات استفهام

[@RR-jv6es]

لمن شريت برامج اوفيس اصليه ماشتغلت الداله معاي اختلفت تماما

[@rashakabbout855]

شكرا اكثر من رائع
ولكن كيف استطيع فصل الكلمات عن بعضها
مثال: خمسةملايين ليرة
ومليونومئتانوخمسونألف
هكذا تظهر عندي ارجو المساعدة وشكراً

[@AAZK-q1g]

هل نقول صفرا دولارا امريكياً او صفر دولار أمريكي او صفر دولارا أمريكيا أريد ان اعرف التشكيل

[@علاءريحاوي-ع2ط]

جزاك الله كل الخير ولكن فيجوال بيسك لا يقبل اللغة العربية عندي ممكن طريقة تعريبه

[@Al_Majalla_Althaqafia]

تفضل الحل في هذا الفيديو في الدقيقة ٥ و ١٠ ثوان:
ruclips.net/video/Ox3wor_h6is/видео.html

[@enasouda2567]

وين الوصف ؟

[@الاجتماعيات-ط3ج]

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

[@Al_Majalla_Althaqafia]

أهلا بك.
من خلال التنسيق الشرطي.

[@Al_Majalla_Althaqafia]

أرسل الملف إذا أحببت على الإيميل:
[e-mail]
حتى أتمكن من مساعدتك.

[@ahmedmohamed552]

الرابط المفروض انسخة فين اوجدو؟

[@طارقالدنف]

اريد رابط الدالة لو سمحت

[@tawfiqahmed8588]

فين رابط الدالة لو تكرمت

[@rouama2674]

وين رابط يلي مننسخ منو؟

[@An.wa2]

يعطيك العافيه لكن لما اطبق الدالة يطلع لي علامة استفهام ياليت اللي عنده حل يفيدنا

[@nureldinsuekit]

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

[@Al_Majalla_Althaqafia]

تفضل الحل في هذا الفيديو في الدقيقة ٥ و ١٠ ثوان:
ruclips.net/video/Ox3wor_h6is/видео.html

[@haniejaz6837]

عندي حرف الواو يجي بداله رقم 9 احد عنده حل

[@MohamedHamed-il3gx]

يوجد مشكله بعد المعدلة بتعمل 0 ممكن السبب

[@Rashid-bh]

مشكلة المئات في الكسور لايقرئها صحيح مثلا 1.120 يقرئها 1.12 الكود يحتاج تصحيح

[@Kerolos_Shaheedl]

عملت الخطوات بالظبط وما نفعتش خالص بيطلعلي علامات استفهام

[@Al_Majalla_Althaqafia]

إن شاء الله تجد الحل في هذا الفيديو:
ruclips.net/video/Ox3wor_h6is/видео.html

[@Kerolos_Shaheedl]

@@Al_Majalla_Althaqafia حضرت الفيديو شكراً ليك اتحلت المشكلة ❤❤

[@Al_Majalla_Althaqafia]

أهلا بك.

[@عابدالشاعر-غ7خ]

قواك الله شرح سهل واكثر من رائع بس الكود ماشفناه لو تكرمت

[@Al_Majalla_Althaqafia]

تفضل الكود:
Function NumberToText(Number As Double, MainCurrency As String, SubCurrency As String)
Dim Array1(0 To 9) As String
Dim Array2(0 To 9) As String
Dim Array3(0 To 9) As String
Dim MyNumber As String
Dim GetNumber As String
Dim ReadNumber As String
Dim My100 As String
Dim My10 As String
Dim My1 As String
Dim My11 As String
Dim My12 As String
Dim GetText As String
Dim Billion As String
Dim Million As String
Dim Thousand As String
Dim Hundred As String
Dim Fraction As String
Dim MyAnd As String
Dim I As Integer
Dim ReMark As String
If Number > 999999999999.99 Then Exit Function
If Number < 0 Then
Number = Number * -1
ReMark = "سالب "
End If
If Number = 0 Then
NumberToText = "صفر"
Exit Function
End If
MyAnd = " و"
Array1(0) = ""
Array1(1) = "مائة"
Array1(2) = "مائتان"
Array1(3) = "ثلاثمائة"
Array1(4) = "أربعمائة"
Array1(5) = "خمسمائة"
Array1(6) = "ستمائة"
Array1(7) = "سبعمائة"
Array1(8) = "ثمانمائة"
Array1(9) = "تسعمائة"
Array2(0) = ""
Array2(1) = " عشر"
Array2(2) = "عشرون"
Array2(3) = "ثلاثون"
Array2(4) = "أربعون"
Array2(5) = "خمسون"
Array2(6) = "ستون"
Array2(7) = "سبعون"
Array2(8) = "ثمانون"
Array2(9) = "تسعون"
Array3(0) = ""
Array3(1) = "واحد"
Array3(2) = "اثنان"
Array3(3) = "ثلاثة"
Array3(4) = "أربعة"
Array3(5) = "خمسة"
Array3(6) = "ستة"
Array3(7) = "سبعة"
Array3(8) = "ثمانية"
Array3(9) = "تسعة"
GetNumber = Format(Number, "000000000000.00")
I = 0
Do While I < 15
If I < 12 Then
MyNumber = Mid$(GetNumber, I + 1, 3)
Else
MyNumber = "0" + Mid$(GetNumber, I + 2, 2)
End If
If (Mid$(MyNumber, 1, 3)) > 0 Then
ReadNumber = Mid$(MyNumber, 1, 1)
My100 = Array1(ReadNumber)
ReadNumber = Mid$(MyNumber, 3, 1)
My1 = Array3(ReadNumber)
ReadNumber = Mid$(MyNumber, 2, 1)
My10 = Array2(ReadNumber)
If Mid$(MyNumber, 2, 2) = 11 Then My11 = "إحدى عشرة"
If Mid$(MyNumber, 2, 2) = 12 Then My12 = "إثنى عشرة"
If Mid$(MyNumber, 2, 2) = 10 Then My10 = "عشرة"
If ((Mid$(MyNumber, 1, 1)) > 0) And ((Mid$(MyNumber, 2, 2)) > 0) Then My100 = My100 + MyAnd
If ((Mid$(MyNumber, 3, 1)) > 0) And ((Mid$(MyNumber, 2, 1)) > 1) Then My1 = My1 + MyAnd
GetText = My100 + My1 + My10
If ((Mid$(MyNumber, 3, 1)) = 1) And ((Mid$(MyNumber, 2, 1)) = 1) Then
GetText = My100 + My11
If ((Mid$(MyNumber, 1, 1)) = 0) Then GetText = My11
End If
If ((Mid$(MyNumber, 3, 1)) = 2) And ((Mid$(MyNumber, 2, 1)) = 1) Then
GetText = My100 + My12
If ((Mid$(MyNumber, 1, 1)) = 0) Then GetText = My12
End If
If (I = 0) And (GetText "") Then
If ((Mid$(MyNumber, 1, 3)) > 10) Then
Billion = GetText + " مليار"
Else
Billion = GetText + " مليارات"
If ((Mid$(MyNumber, 1, 3)) = 2) Then Billion = " مليار"
If ((Mid$(MyNumber, 1, 3)) = 2) Then Billion = " مليارن"
End If
End If
If (I = 3) And (GetText "") Then
If ((Mid$(MyNumber, 1, 3)) > 10) Then
Million = GetText + " مليون"
Else
Million = GetText + " ملايين"
If ((Mid$(MyNumber, 1, 3)) = 1) Then Million = " مليون"
If ((Mid$(MyNumber, 1, 3)) = 2) Then Million = " مليونان"
End If
End If
If (I = 6) And (GetText "") Then
If ((Mid$(MyNumber, 1, 3)) > 10) Then
Thousand = GetText + " ألف"
Else
Thousand = GetText + " ألاف"
If ((Mid$(MyNumber, 3, 1)) = 1) Then Thousand = " ألف"
If ((Mid$(MyNumber, 3, 1)) = 2) Then Thousand = " ألفان"
End If
End If
If (I = 9) And (GetText "") Then Hundred = GetText
If (I = 12) And (GetText "") Then Fraction = GetText
End If
I = I + 3
Loop
If (Billion "") Then
If (Million "") Or (Thousand "") Or (Hundred "") Then Billion = Billion + MyAnd
End If
If (Million "") Then
If (Thousand "") Or (Hundred "") Then Million = Million + MyAnd
End If
If (Thousand "") Then
If (Hundred "") Then Thousand = Thousand + MyAnd
End If
If Fraction "" Then
If (Billion "") Or (Million "") Or (Thousand "") Or (Hundred "") Then
NumberToText = ReMark + Billion + Million + Thousand + Hundred + " " + MainCurrency + MyAnd + Fraction + " " + SubCurrency
Else
NumberToText = ReMark + Fraction + " " + SubCurrency
End If
Else
NumberToText = ReMark + Billion + Million + Thousand + Hundred + " " + MainCurrency
End If
End Function

[@Al_Majalla_Althaqafia]

تفضل الكود:
Function NumberToText(Number As Double, MainCurrency As String, SubCurrency As String)
Dim Array1(0 To 9) As String
Dim Array2(0 To 9) As String
Dim Array3(0 To 9) As String
Dim MyNumber As String
Dim GetNumber As String
Dim ReadNumber As String
Dim My100 As String
Dim My10 As String
Dim My1 As String
Dim My11 As String
Dim My12 As String
Dim GetText As String
Dim Billion As String
Dim Million As String
Dim Thousand As String
Dim Hundred As String
Dim Fraction As String
Dim MyAnd As String
Dim I As Integer
Dim ReMark As String
If Number > 999999999999.99 Then Exit Function
If Number < 0 Then
Number = Number * -1
ReMark = "سالب "
End If
If Number = 0 Then
NumberToText = "صفر"
Exit Function
End If
MyAnd = " و"
Array1(0) = ""
Array1(1) = "مائة"
Array1(2) = "مائتان"
Array1(3) = "ثلاثمائة"
Array1(4) = "أربعمائة"
Array1(5) = "خمسمائة"
Array1(6) = "ستمائة"
Array1(7) = "سبعمائة"
Array1(8) = "ثمانمائة"
Array1(9) = "تسعمائة"
Array2(0) = ""
Array2(1) = " عشر"
Array2(2) = "عشرون"
Array2(3) = "ثلاثون"
Array2(4) = "أربعون"
Array2(5) = "خمسون"
Array2(6) = "ستون"
Array2(7) = "سبعون"
Array2(8) = "ثمانون"
Array2(9) = "تسعون"
Array3(0) = ""
Array3(1) = "واحد"
Array3(2) = "اثنان"
Array3(3) = "ثلاثة"
Array3(4) = "أربعة"
Array3(5) = "خمسة"
Array3(6) = "ستة"
Array3(7) = "سبعة"
Array3(8) = "ثمانية"
Array3(9) = "تسعة"
GetNumber = Format(Number, "000000000000.00")
I = 0
Do While I < 15
If I < 12 Then
MyNumber = Mid$(GetNumber, I + 1, 3)
Else
MyNumber = "0" + Mid$(GetNumber, I + 2, 2)
End If
If (Mid$(MyNumber, 1, 3)) > 0 Then
ReadNumber = Mid$(MyNumber, 1, 1)
My100 = Array1(ReadNumber)
ReadNumber = Mid$(MyNumber, 3, 1)
My1 = Array3(ReadNumber)
ReadNumber = Mid$(MyNumber, 2, 1)
My10 = Array2(ReadNumber)
If Mid$(MyNumber, 2, 2) = 11 Then My11 = "إحدى عشرة"
If Mid$(MyNumber, 2, 2) = 12 Then My12 = "إثنى عشرة"
If Mid$(MyNumber, 2, 2) = 10 Then My10 = "عشرة"
If ((Mid$(MyNumber, 1, 1)) > 0) And ((Mid$(MyNumber, 2, 2)) > 0) Then My100 = My100 + MyAnd
If ((Mid$(MyNumber, 3, 1)) > 0) And ((Mid$(MyNumber, 2, 1)) > 1) Then My1 = My1 + MyAnd
GetText = My100 + My1 + My10
If ((Mid$(MyNumber, 3, 1)) = 1) And ((Mid$(MyNumber, 2, 1)) = 1) Then
GetText = My100 + My11
If ((Mid$(MyNumber, 1, 1)) = 0) Then GetText = My11
End If
If ((Mid$(MyNumber, 3, 1)) = 2) And ((Mid$(MyNumber, 2, 1)) = 1) Then
GetText = My100 + My12
If ((Mid$(MyNumber, 1, 1)) = 0) Then GetText = My12
End If
If (I = 0) And (GetText "") Then
If ((Mid$(MyNumber, 1, 3)) > 10) Then
Billion = GetText + " مليار"
Else
Billion = GetText + " مليارات"
If ((Mid$(MyNumber, 1, 3)) = 2) Then Billion = " مليار"
If ((Mid$(MyNumber, 1, 3)) = 2) Then Billion = " مليارن"
End If
End If
If (I = 3) And (GetText "") Then
If ((Mid$(MyNumber, 1, 3)) > 10) Then
Million = GetText + " مليون"
Else
Million = GetText + " ملايين"
If ((Mid$(MyNumber, 1, 3)) = 1) Then Million = " مليون"
If ((Mid$(MyNumber, 1, 3)) = 2) Then Million = " مليونان"
End If
End If
If (I = 6) And (GetText "") Then
If ((Mid$(MyNumber, 1, 3)) > 10) Then
Thousand = GetText + " ألف"
Else
Thousand = GetText + " ألاف"
If ((Mid$(MyNumber, 3, 1)) = 1) Then Thousand = " ألف"
If ((Mid$(MyNumber, 3, 1)) = 2) Then Thousand = " ألفان"
End If
End If
If (I = 9) And (GetText "") Then Hundred = GetText
If (I = 12) And (GetText "") Then Fraction = GetText
End If
I = I + 3
Loop
If (Billion "") Then
If (Million "") Or (Thousand "") Or (Hundred "") Then Billion = Billion + MyAnd
End If
If (Million "") Then
If (Thousand "") Or (Hundred "") Then Million = Million + MyAnd
End If
If (Thousand "") Then
If (Hundred "") Then Thousand = Thousand + MyAnd
End If
If Fraction "" Then
If (Billion "") Or (Million "") Or (Thousand "") Or (Hundred "") Then
NumberToText = ReMark + Billion + Million + Thousand + Hundred + " " + MainCurrency + MyAnd + Fraction + " " + SubCurrency
Else
NumberToText = ReMark + Fraction + " " + SubCurrency
End If
Else
NumberToText = ReMark + Billion + Million + Thousand + Hundred + " " + MainCurrency
End If
End Function

[@عابدالشاعر-غ7خ]

@@Al_Majalla_Althaqafia تسلم والله تسلم كل الشكر والتقدير والاحترام لشخصك الراقي والمميز

[@faridhakim508]

@@Al_Majalla_Althaqafia ابعتلي الكود من فضلك

[@Al_Majalla_Althaqafia]

تفضل الكود:
Function NumberToText(Number As Double, MainCurrency As String, SubCurrency As String)
Dim Array1(0 To 9) As String
Dim Array2(0 To 9) As String
Dim Array3(0 To 9) As String
Dim MyNumber As String
Dim GetNumber As String
Dim ReadNumber As String
Dim My100 As String
Dim My10 As String
Dim My1 As String
Dim My11 As String
Dim My12 As String
Dim GetText As String
Dim Billion As String
Dim Million As String
Dim Thousand As String
Dim Hundred As String
Dim Fraction As String
Dim MyAnd As String
Dim I As Integer
Dim ReMark As String
If Number > 999999999999.99 Then Exit Function
If Number < 0 Then
Number = Number * -1
ReMark = "سالب "
End If
If Number = 0 Then
NumberToText = "صفر"
Exit Function
End If
MyAnd = " و"
Array1(0) = ""
Array1(1) = "مائة"
Array1(2) = "مائتان"
Array1(3) = "ثلاثمائة"
Array1(4) = "أربعمائة"
Array1(5) = "خمسمائة"
Array1(6) = "ستمائة"
Array1(7) = "سبعمائة"
Array1(8) = "ثمانمائة"
Array1(9) = "تسعمائة"
Array2(0) = ""
Array2(1) = " عشر"
Array2(2) = "عشرون"
Array2(3) = "ثلاثون"
Array2(4) = "أربعون"
Array2(5) = "خمسون"
Array2(6) = "ستون"
Array2(7) = "سبعون"
Array2(8) = "ثمانون"
Array2(9) = "تسعون"
Array3(0) = ""
Array3(1) = "واحد"
Array3(2) = "اثنان"
Array3(3) = "ثلاثة"
Array3(4) = "أربعة"
Array3(5) = "خمسة"
Array3(6) = "ستة"
Array3(7) = "سبعة"
Array3(8) = "ثمانية"
Array3(9) = "تسعة"
GetNumber = Format(Number, "000000000000.00")
I = 0
Do While I < 15
If I < 12 Then
MyNumber = Mid$(GetNumber, I + 1, 3)
Else
MyNumber = "0" + Mid$(GetNumber, I + 2, 2)
End If
If (Mid$(MyNumber, 1, 3)) > 0 Then
ReadNumber = Mid$(MyNumber, 1, 1)
My100 = Array1(ReadNumber)
ReadNumber = Mid$(MyNumber, 3, 1)
My1 = Array3(ReadNumber)
ReadNumber = Mid$(MyNumber, 2, 1)
My10 = Array2(ReadNumber)
If Mid$(MyNumber, 2, 2) = 11 Then My11 = "إحدى عشرة"
If Mid$(MyNumber, 2, 2) = 12 Then My12 = "إثنى عشرة"
If Mid$(MyNumber, 2, 2) = 10 Then My10 = "عشرة"
If ((Mid$(MyNumber, 1, 1)) > 0) And ((Mid$(MyNumber, 2, 2)) > 0) Then My100 = My100 + MyAnd
If ((Mid$(MyNumber, 3, 1)) > 0) And ((Mid$(MyNumber, 2, 1)) > 1) Then My1 = My1 + MyAnd
GetText = My100 + My1 + My10
If ((Mid$(MyNumber, 3, 1)) = 1) And ((Mid$(MyNumber, 2, 1)) = 1) Then
GetText = My100 + My11
If ((Mid$(MyNumber, 1, 1)) = 0) Then GetText = My11
End If
If ((Mid$(MyNumber, 3, 1)) = 2) And ((Mid$(MyNumber, 2, 1)) = 1) Then
GetText = My100 + My12
If ((Mid$(MyNumber, 1, 1)) = 0) Then GetText = My12
End If
If (I = 0) And (GetText "") Then
If ((Mid$(MyNumber, 1, 3)) > 10) Then
Billion = GetText + " مليار"
Else
Billion = GetText + " مليارات"
If ((Mid$(MyNumber, 1, 3)) = 2) Then Billion = " مليار"
If ((Mid$(MyNumber, 1, 3)) = 2) Then Billion = " مليارن"
End If
End If
If (I = 3) And (GetText "") Then
If ((Mid$(MyNumber, 1, 3)) > 10) Then
Million = GetText + " مليون"
Else
Million = GetText + " ملايين"
If ((Mid$(MyNumber, 1, 3)) = 1) Then Million = " مليون"
If ((Mid$(MyNumber, 1, 3)) = 2) Then Million = " مليونان"
End If
End If
If (I = 6) And (GetText "") Then
If ((Mid$(MyNumber, 1, 3)) > 10) Then
Thousand = GetText + " ألف"
Else
Thousand = GetText + " ألاف"
If ((Mid$(MyNumber, 3, 1)) = 1) Then Thousand = " ألف"
If ((Mid$(MyNumber, 3, 1)) = 2) Then Thousand = " ألفان"
End If
End If
If (I = 9) And (GetText "") Then Hundred = GetText
If (I = 12) And (GetText "") Then Fraction = GetText
End If
I = I + 3
Loop
If (Billion "") Then
If (Million "") Or (Thousand "") Or (Hundred "") Then Billion = Billion + MyAnd
End If
If (Million "") Then
If (Thousand "") Or (Hundred "") Then Million = Million + MyAnd
End If
If (Thousand "") Then
If (Hundred "") Then Thousand = Thousand + MyAnd
End If
If Fraction "" Then
If (Billion "") Or (Million "") Or (Thousand "") Or (Hundred "") Then
NumberToText = ReMark + Billion + Million + Thousand + Hundred + " " + MainCurrency + MyAnd + Fraction + " " + SubCurrency
Else
NumberToText = ReMark + Fraction + " " + SubCurrency
End If
Else
NumberToText = ReMark + Billion + Million + Thousand + Hundred + " " + MainCurrency
End If
End Function

[@mahmoudshehab3041]

لو سمحت الناتج اصبح كده ايه الحل ؟؟؟؟؟؟؟؟؟؟؟؟؟؟ جنيه مصري ؟؟؟؟؟ قرش

[@Al_Majalla_Althaqafia]

تفضل الحل في هذا الفيديو في الدقيقة ٥ و ١٠ ثوان:
ruclips.net/video/Ox3wor_h6is/видео.html

[@mohamadebnghanam4896]

تظهر لي علامات الاستفهام بدل ترجمة الارقام الى كلمات، ايش الحل؟

[@luqmanbaban3573]

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

[@عابدالشاعر-غ7خ]

من fx

[@ramyn.atadrus3409]

حل سهل وبسيط لكن في مشكلة وهي في عمله الدينار الكويتي والكسور تكون مئوية وليست عشرية

[@gamingmaster5727]

لما بعمل لصق الاحروف الي بالعربي مش بتظهر

[@raoufraouf4612]

اين الداله

[@IS.AS.]

لدي مشكلة أن البرنامج لا يقرأ الكلمات العربية في المعادلة وتظهر بهذا الشكل:
MyAnd = " ?"
Array1(0) = ""
Array1(1) = "????"
Array1(2) = "??????"
Array1(3) = "????????"
Array1(4) = "????????"
Array1(5) = "???????"
Array1(6) = "??????"
Array1(7) = "???????"
Array1(8) = "????????"
Array1(9) = "???????"

[@abdulrahmanal-abdulla8956]

عاشت ايدك

[@عالمسمسم-خ8ش]

كيف يتم ضبط اللغة

[@OudyAbdelslam]

اريد الرابط ولكنه لا ينسخ

[@shehabaliabdoameer9581]

وين الداله ...ما وجدتها

[@saeedrun]

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

[@Al_Majalla_Althaqafia]

تفضل الحل في هذا الفيديو في الدقيقة ٥ و ١٠ ثوان:
ruclips.net/video/Ox3wor_h6is/видео.html

[@الملكمحمد-ض5ج]

لو سمحت ياهندسه انا موجود في الكويت وعمله الكويت الدينار الكويتي والدينار فيه ١٠٠٠ فلس يعني نص دينار ٥٠٠ فلس لما بكتب مثلاً ٣٣ دينار و ٥٠٠ فلس بيكتب معايا التفقيط ثلاثه وثلاثون دينار وخمسون فلس ومحول العمله عندي ومخلي بعد الكسر تلات اصفار ممكن حضرتك تساعدني على حل المشكلة وجزاك الله خير أو ترسل لي كود معدل على الدينار الكويتي الفلس العمله الفرعيه لما اجي اكتب ٣٣.٥٠٠ يكتبلي في التفقيط ثلاثه وثلاثون دينار و خمسمائه فلس وشكراً

[@AbubakerNsaiya]

نفس المشكلة في العملة الليبية
الدينار يتكون من ألف درهم

[@FadiSaif-b7l]

شكرا لك وجزاك الله خير ❤ استاذي طبقت الدالة لكن تطلع عندي الاحرف متشابكة

[@djaberimed4654]

أين الكود ربي يبارك فيك

[@HassanAli-ub9ep]

الرابط لا يعمل اللى فيه الكود

[@Al_Majalla_Althaqafia]

توجد مشكلة في الموقع، تفضل ملف الكود:
www.mediafire.com/file/5j5cxun923jey0o/تحويل+الرقم+إلى+نص.txt/file

[@ابونوافنايف-ز5ي]

ذكريات جميلة

[@rahmikd]

كيف تحول اللغة الى لغات أخرى مثل الفرنسية والإنجليزية

[@انمارحامدالعراقي]

ممكن الكود

[@maryamhbaizi7345]

وين دالة

[@nasralhasnial-zaghena8468]

تقدرو ترسلوه برساله الكود الذي تم نسخه

[@Al_Majalla_Althaqafia]

Function NumberToText(Number As Double, MainCurrency As String, SubCurrency As String)
Dim Array1(0 To 9) As String
Dim Array2(0 To 9) As String
Dim Array3(0 To 9) As String
Dim MyNumber As String
Dim GetNumber As String
Dim ReadNumber As String
Dim My100 As String
Dim My10 As String
Dim My1 As String
Dim My11 As String
Dim My12 As String
Dim GetText As String
Dim Billion As String
Dim Million As String
Dim Thousand As String
Dim Hundred As String
Dim Fraction As String
Dim MyAnd As String
Dim I As Integer
Dim ReMark As String
If Number > 999999999999.99 Then Exit Function
If Number < 0 Then
Number = Number * -1
ReMark = "سالب "
End If
If Number = 0 Then
NumberToText = "صفر"
Exit Function
End If
MyAnd = " و"
Array1(0) = ""
Array1(1) = "مائة"
Array1(2) = "مائتان"
Array1(3) = "ثلاثمائة"
Array1(4) = "أربعمائة"
Array1(5) = "خمسمائة"
Array1(6) = "ستمائة"
Array1(7) = "سبعمائة"
Array1(8) = "ثمانمائة"
Array1(9) = "تسعمائة"
Array2(0) = ""
Array2(1) = " عشر"
Array2(2) = "عشرون"
Array2(3) = "ثلاثون"
Array2(4) = "أربعون"
Array2(5) = "خمسون"
Array2(6) = "ستون"
Array2(7) = "سبعون"
Array2(8) = "ثمانون"
Array2(9) = "تسعون"
Array3(0) = ""
Array3(1) = "واحد"
Array3(2) = "اثنان"
Array3(3) = "ثلاثة"
Array3(4) = "أربعة"
Array3(5) = "خمسة"
Array3(6) = "ستة"
Array3(7) = "سبعة"
Array3(8) = "ثمانية"
Array3(9) = "تسعة"
GetNumber = Format(Number, "000000000000.00")
I = 0
Do While I < 15
If I < 12 Then
MyNumber = Mid$(GetNumber, I + 1, 3)
Else
MyNumber = "0" + Mid$(GetNumber, I + 2, 2)
End If
If (Mid$(MyNumber, 1, 3)) > 0 Then
ReadNumber = Mid$(MyNumber, 1, 1)
My100 = Array1(ReadNumber)
ReadNumber = Mid$(MyNumber, 3, 1)
My1 = Array3(ReadNumber)
ReadNumber = Mid$(MyNumber, 2, 1)
My10 = Array2(ReadNumber)
If Mid$(MyNumber, 2, 2) = 11 Then My11 = "إحدى عشرة"
If Mid$(MyNumber, 2, 2) = 12 Then My12 = "إثنى عشرة"
If Mid$(MyNumber, 2, 2) = 10 Then My10 = "عشرة"
If ((Mid$(MyNumber, 1, 1)) > 0) And ((Mid$(MyNumber, 2, 2)) > 0) Then My100 = My100 + MyAnd
If ((Mid$(MyNumber, 3, 1)) > 0) And ((Mid$(MyNumber, 2, 1)) > 1) Then My1 = My1 + MyAnd
GetText = My100 + My1 + My10
If ((Mid$(MyNumber, 3, 1)) = 1) And ((Mid$(MyNumber, 2, 1)) = 1) Then
GetText = My100 + My11
If ((Mid$(MyNumber, 1, 1)) = 0) Then GetText = My11
End If
If ((Mid$(MyNumber, 3, 1)) = 2) And ((Mid$(MyNumber, 2, 1)) = 1) Then
GetText = My100 + My12
If ((Mid$(MyNumber, 1, 1)) = 0) Then GetText = My12
End If
If (I = 0) And (GetText "") Then
If ((Mid$(MyNumber, 1, 3)) > 10) Then
Billion = GetText + " مليار"
Else
Billion = GetText + " مليارات"
If ((Mid$(MyNumber, 1, 3)) = 2) Then Billion = " مليار"
If ((Mid$(MyNumber, 1, 3)) = 2) Then Billion = " مليارن"
End If
End If
If (I = 3) And (GetText "") Then
If ((Mid$(MyNumber, 1, 3)) > 10) Then
Million = GetText + " مليون"
Else
Million = GetText + " ملايين"
If ((Mid$(MyNumber, 1, 3)) = 1) Then Million = " مليون"
If ((Mid$(MyNumber, 1, 3)) = 2) Then Million = " مليونان"
End If
End If
If (I = 6) And (GetText "") Then
If ((Mid$(MyNumber, 1, 3)) > 10) Then
Thousand = GetText + " ألف"
Else
Thousand = GetText + " ألاف"
If ((Mid$(MyNumber, 3, 1)) = 1) Then Thousand = " ألف"
If ((Mid$(MyNumber, 3, 1)) = 2) Then Thousand = " ألفان"
End If
End If
If (I = 9) And (GetText "") Then Hundred = GetText
If (I = 12) And (GetText "") Then Fraction = GetText
End If
I = I + 3
Loop
If (Billion "") Then
If (Million "") Or (Thousand "") Or (Hundred "") Then Billion = Billion + MyAnd
End If
If (Million "") Then
If (Thousand "") Or (Hundred "") Then Million = Million + MyAnd
End If
If (Thousand "") Then
If (Hundred "") Then Thousand = Thousand + MyAnd
End If
If Fraction "" Then
If (Billion "") Or (Million "") Or (Thousand "") Or (Hundred "") Then
NumberToText = ReMark + Billion + Million + Thousand + Hundred + " " + MainCurrency + MyAnd + Fraction + " " + SubCurrency
Else
NumberToText = ReMark + Fraction + " " + SubCurrency
End If
Else
NumberToText = ReMark + Billion + Million + Thousand + Hundred + " " + MainCurrency
End If
End Function

[@osmanabosalhen8622]

@@Al_Majalla_Althaqafia لو سمحت تبعلتى اللينك

[@khaledzaki2698]

​@@Al_Majalla_Althaqafia 0:20