![Mohammed Al-Molegi](/img/default-banner.jpg)
- 15
- 35 976
Mohammed Al-Molegi
Приєднався 17 лют 2012
كيفية إنشاء القوائم المنسدلة المترابطة ببرنامج اكسل - Excel
إنشاء القوائم المنسدلة المترابطة باستخدام اكسل - Excel
Переглядів: 366
Відео
كيفية تحويل الأرقام إلى كلمات ببرنامج الأكسل - Excel (تفقيط الأرقام)
Переглядів 11 тис.Рік тому
www.excelawy.com/2017/09/convert-number-to-text-excel.html
كيفية تصميم لوحة بيانات تفاعلية (Dashboard) ببرنامج الاكسل - Excel
Переглядів 12 тис.Рік тому
كيفية تصميم لوحة بيانات تفاعلية (Dashboard) ببرنامج الاكسل - Excel
كيفية تحريك الصفوف والأعمدة بالجداول في برنامج أكسل و ورد - Excel and Word
Переглядів 8 тис.Рік тому
كيفية تحريك الصفوف والأعمدة بالجداول في برنامج أكسل و ورد - Excel and Word
حل مشكلة إيجاد الفرق بين تاريخين في برنامج أكسل - Excel
Переглядів 4 тис.Рік тому
حل مشكلة إيجاد الفرق بين تاريخين في برنامج أكسل - Excel
9- تصميم وبرمجة شاشة طباعة التقارير بالفيجوال بيسك المثال الثاني Print Form, VB net Example 2
Переглядів 343Рік тому
9- تصميم وبرمجة شاشة طباعة التقارير بالفيجوال بيسك المثال الثاني Print Form, VB net Example 2
8- تصميم وبرمجة شاشة طباعة التقارير بالفيجوال بيسك المثال الأول Print Form, VB net Example 1
Переглядів 431Рік тому
8- تصميم وبرمجة شاشة طباعة التقارير بالفيجوال بيسك المثال الأول Print Form, VB net Example 1
7- تصميم وبرمجة شاشة الحذف بالفيجوال بيسك Delete Form, VB net
Переглядів 40Рік тому
7- تصميم وبرمجة شاشة الحذف بالفيجوال بيسك Delete Form, VB net
6- تصميم وبرمجة شاشة تعديل البيانات بالفيجوال بيسكUpdate records Form, VB net
Переглядів 110Рік тому
6- تصميم وبرمجة شاشة تعديل البيانات بالفيجوال بيسكUpdate records Form, VB net
5- تصميم وبرمجة شاشة إضافة سجلات جديدة لقاعدة البيانات بالفيجوال بيسك Add New Form, VB net
Переглядів 67Рік тому
5- تصميم وبرمجة شاشة إضافة سجلات جديدة لقاعدة البيانات بالفيجوال بيسك Add New Form, VB net
4- تصميم وبرمجة شاشة بحث رائعة بالفيجوال بيسك الجزء الثانيSearch Form, VB net Part 2
Переглядів 46Рік тому
4- تصميم وبرمجة شاشة بحث رائعة بالفيجوال بيسك الجزء الثانيSearch Form, VB net Part 2
3- تصميم وبرمجة شاشة بحث رائعة بالفيجوال بيسك الجزء الأول Search Form, VB net Part 1
Переглядів 49Рік тому
3- تصميم وبرمجة شاشة بحث رائعة بالفيجوال بيسك الجزء الأول Search Form, VB net Part 1
2- تصميم وبرمجة شاشة الدخول بالفيجوال بيسك الجزء الثانيlogin Form, VB net Part 2
Переглядів 63Рік тому
تصميم وبرمجة شاشة الدخول بالفيجول بيسك الجزء الثاني Login design and programming, VB.Net, ADO.Net, Part 2
1- تصميم وبرمجة شاشة الدخول بالفيجوال بيسك الجزء الأول login Form, VB net Part 1
Переглядів 112Рік тому
تصميم وبرمجة شاشة الدخول بالفيجوال بيسك الجزء الأول Login Design and Programming, VB.Net, ADO.Net, Part 1
رابط التحميل ؟
مبدع بصراحه اختصرت لنا موضوعين provit tables and dashboard شرحتها بكل فن وفهمناها سريع تحياتي لك، الله يوفقك.
عدت الفديو أكثر من مرة لكي اعرف كيف رتبت البيانات بس ماوضحت
انت انسان محترم الله يبارك لك
الله يسعدك. شرح وافي وكافي للموضوع بدون فلسفة ومطمطة كلام. تحياتي لك ولااهل اليمن الكرام
لو تكرمت نبقى تفقيط في لابتوب باللغه العربيه
ممكن الجدول اللي اشتغلت ؟
الف شكر ع هذا الشرح الرائع. سؤال لوسمحت ، هل ممكن اعمل قوائم من ٣و ٤ وبنفس طريقة الذي طبقتها انت. وشكرا
لو سمحت ممكن ملف الاكسل عشان نطبق علي الشرح
الحساب الاول هو الصح... من اليسار الى اليمن.. اليوم .. الشهر .. السنة.. انت قلبتها وشقلبتها واتهمت البرنامج تهمه باطلة
لسه فيه خطا عند حضرتك..
ربنا يجزيك الخير يا رب العالمين - شرح مبسط وجميل جدا
ما شاء الله جزاك الله خيرا هل من الممكن وضع هذا الداش بورد اونلاين يعني اعطي رابط لاشخاص محددين يمكنهم الاطلاع عليه
ممكن طريقة الاتصال بقاعدة بيانات
ما شاء الله ممتاز
بعد اذنك عاوزين شيت الاكسيل عشان نطبق عليه بعد اذن حضرتك نزله ف وصف الفيديو او ف كومنت
ما شاء الله عظيم ربنا يباركلك 👏🏻👏🏻❤️
شرح كويس ومبسط مع تنسيق شيك شكرا ربنا يزيد من علمه وفضله ويجعله علم ينتفع به ❤❤
الكود
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
الكود ؟
الكود لو سمحت
بارك الله فيكم وفي جهودكم نسأل الله العظيم ان يجعلها في ميزان حسناتكم يوم القيامة
❤
ممتاز ويستحق التجربة . كنت افكر اعمل زيها بالpower bi لكن حالياً مش عارف ايش الفرق بينه وبين الاكسل في خاصية البوردات التفاعلية
طيب حول البرنامج بالعربي دام شرحك للعرب
يعطيك الف عافية وكتب الله اجرك بالشهر الكريم جد كنت احتاجها شرح جميل ومحترف الله يرفع بعلمك ويجزاك خير لنشره
ياريت لو ترسل ملف الاكسل الخاص بالعمل بالوصف
لو مثل اشتي لا درجة
تحية لك على المجهود
شكرا جزيلا دكتور
رائع شكرا لك
يطلع استفهامات ليه ؟
انسخ الكود لملف ورد (Word) أولا ثم انسخه مرة ثانية من ملف الورد إلى ملف الأكسل وبيزبط معاك
ما يزبط
يطلع استفهامات او كلام يوناني
أواجه نفس المشكله @@Mohasindi
@@Mohasindi انسخ الكلام كله في ملف ورد جديد وقبل ما تعمله لصق عالاكسيل اتاكد ان الكلام العربي منسوخ صح يعني هتاخده نسخ الاول من ملف التكست وبعدين تعمله لصق لملف ورد وبعدين تاخده تاني نسخ من ملف الورد وبعدين تعمله لصف عالاكسيل
ممتاز شكرآ كيف اتواصل مع حضرتك
تعرف تعمل صفحةمح ك بحث
طيب حط ملف العمل عشان نطبق
حفظك الله ورعاك ممكن الداله
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
ما قبل معي ، اول ما اعمل المعادلة بعد نسخ الكود ما يقبل يرجعنا الى الماكرو الكود ويكون المؤشر اخر الكود
اللي بيسال عن الكود موجود في اللينك في صندوق الوصف , بعد ما تعمل نسخ ولصق لصفحة المديول عدل علامات الاستفهام للكلمات الموجودة باللغة العربية بين علامات التنصيص علشان الكود يشتغل
ممكن الطريقة او ارسال الكود بعد التعديل
اول مرة احمل كود ويشتغل معايا بجد فعلا متشكر جدا جدا جعلة الله في ميزان حسناتك
الله يجازيك خير يارب - اسهل طريقة - شكرا🙏
عظيم جدآ
الكود من فضلك
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
شكرا
@@mohammed-almolegi
الكود لو سمحت❤
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
@@mohammed-almolegi شكرا
@@mohammed-almolegi شكرا
الكود لو سمحت
ممكن لو سمحت الدالة
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
ممتاز
شكرا جزيلا لك على المعلومة استمر يا بطل
ممكن لو تكرمت عمل فيديو عن تفقيط درجات الطلاب باللغة العربية
الفيديو موجود بالقناة حالياً.