ناصر سعيد

جزاك الله خيرا استاذ زيزو يحفظك ربنا

كيف يمكن الاستفاده من هذه الداله من فضلكم اعطوا مثالا للتطبيق عليها ؟

كيف يمكن الاستفاده من هذه الداله من فضلكم اعطوا مثالا للتطبيق عليها ؟

كيف يمكن الاستفاده من هذه الداله من فضلكم اعطوا مثالا للتطبيق عليها ؟

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

من فضلكم .. ما فائده هذه الداله ؟ اخي الكريم استاذ احمد الى ان يرد علينا الاستاذ الكبير زيزو انت بتستخدم هذه الداله في اي شيء ( عشان الداله تعمل ايه )

من فضلكم .. ما فائده هذه الداله ؟

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

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

وبارك الله فيك اخي استاذ علي ورعاك

Function DateToLettre(Dat As Date, Criteria As Byte) As String ' Created By Benkhalifa ' Djemoui Alger: 23/02/2018 Dim MyDays As Variant Dim MyMonths As Variant Dim MyChif As Variant Dim Cent As String Dim Mill As String Dim i, J As Byte: J = 0 '=============================================================================================================================== MyDays = Array("", "اليوم الأول", "اليوم الثاني", "اليوم الثالث", "اليوم الرابع", "اليوم الخامس", "اليوم السادس", _ "اليوم السابع", "اليوم الثامن", "اليوم التاسع", "اليوم العاشر", "اليوم الحادي عشر", "اليوم الثاني عشر", _ "ليوم الثالث عشر", "اليوم الرابع عشر", "اليوم الخامس عشر", "اليوم السادس عشر", "اليوم السابع عشر", "اليوم الثامن عشر", _ "اليوم التاسع عشر", "اليوم العشرون", "اليوم الواحد و العشرون", "اليوم الثاني و العشرون", "اليوم الثالث و العشرون", "اليوم الرابع و العشرون", _ "ليوم الخامس و العشرون", "اليوم السادس و العشرون", "اليوم السابع و العشرون", "اليوم الثامن و العشرون", "اليوم التاسع و العشرون", "اليوم الثلاثون", _ "اليوم الواحد و الثلاثون") '=============================================================================================================================== MyMonths1 = Array("", "شهر جانفي", "شهر فيفري", "شهر مارس", "شهر أفريل", "شهر ماي", "شهر جوان", "شهر جويلية", "شهر أوت", "شهر سبتمبر", "شهر أكتوبر", "شهر نوفمبر", "شهر ديسمبر") MyMonths2 = Array("", "شهر يناير", "شهر فبراير", "شهر مارس", "شهر أبريل", "شهر مايو", "شهر يونيو", "شهر يوليو", "شهر أغسطس", "شهر سبتمبر", "شهر أكتوبر", "شهر نوفمبر", "شهر ديسمبر") MyMonths3 = Array("", "شهر كانون الثاني", "شهر شباط", "شهر آذار", "شهر نيسان", "شهر أيار", "شهر حزيران", "شهر تموز", "شهر آب", "شهر أيلول", "شهر تشرين الأول", "شهر تشرين الثاني", "شهر كانون الأول") MyMonths4 = Array("", "شهر محرم", "شهر صفر", "شهر رييع الأول", "شهر ربيع الثاني", "شهر جمادى الأول", "شهر جمادى الثاني", "شهر رجب", "شهر شعبان", "شهر رمضان", "شهر شوال", "شهر ذي القعدة", "شهر ذي الحجة") '=============================================================================================================================== MyChif = Array("صفر", "واحد", "إثنان", "ثلاث", "أربع", "خمس", "ست", "سبع", "ثمان", "تسع", _ "عشرة", "إحدى عشر", "إثنى عشر", "ثلاثة عشر", "أربعة عشر", "خمسة عشر", "ستة عشر", "سبعة عشر", "ثمانية عشر", _ "تسعة عشر", "عشرون", "واحد و عشرون", "إثنان و عشرون", "ثلاثة و عشرون", "أربعة و عشرون", "خمسة و عشرون", "ستة و عشرون", _ "سبعة و عشرون", "ثمانية و عشرون", "تسعة عشرون", "ثلاثون", "واحد و ثلاثون", "إثنان و ثلاثون", "ثلاثة و ثلاثون", "أربعة و ثلاثون", _ "خمسة و ثلاثون", "ستة و ثلاثون", "سبعة و ثلاثون", "ثمانية و ثلاثون", "تسعة و ثلاثون", "أربعون", _ "واحد و أربعون", "إثنان و أربعون", "ثلاثة و أربعون", "أربعة و أربعون", "خمسة و أربعون", "ستة و أربعون", _ "سبعة و أربعون", "ثمانية و أربعون", "تسعة و أربعون", "خمسون", "واحد و خمسون", "إثنان و خمسون", "ثلاثة و خمسون", "أربعة و خمسون", _ "خمسة و خمسون", "ستة و خمسون", "سبعة و خمسون", "ثمانية و خمسون", "تسعة و خمسون", "ستون", "واحد و ستون", _ "إثنان و ستون", "ثلاثة و ستون", "أربعة و ستون", "خمسة و ستون", "ستة ستون", _ "سبعة و ستون", "ثمانية و ستون", "تسعة و ستون", "سبعون", "واحد و سبعون", "إثنان و سبعون", "ثلاثة و سبعون", _ "أربع و سبعون", "خمس و سبعون", "ستة و سبعون", "سبعة و سبعون", "ثمانية و سبعون", "تسعة و سبعون", "ثمانون", "واحد و ثمانون", _ "إثنان و ثمانون", "ثلاث و ثمانون", "أربعة و ثمانون", "خمسة و ثمانون", "ستة و ثمانون", "سبعة و ثمانون", _ "ثمانية و ثمانون", "تسع و ثمانون", "تسعون", "واحد و تسعون", "إثنان و تسعون", "ثلاثة و تسعون", "أربعة و تسعون", _ "خمسة و تسعون", "تسعون", "سبعة و تسعون", "ثمانية و تسعون", "تسعة و تسعون", " مائة ") '=============================================================================================================================== Do While J < 2 i = Mid$(Year(Dat), J + 1, 4) '=============================================================================================================================== If Len(i) = 4 Then Select Case i Case 1 To 999: Mill = MyChif(i) Case 1000 To 9999: Select Case Int(i / 1000) Case 1: If Format(Mid$(i, 2, 4), "000") = "000" Then Mill = " ألف" Else: Mill = " ألف و " Case 2: If Format(Mid$(i, 2, 4), "000") = "000" Then Mill = " ألفان" Else Mill = " ألفان و " Case 3 To 10: If Format(Mid$(i, 2, 4), "000") = "000" Then Mill = MyChif(Int(i / 1000)) & " آلاف" Else If Int(i / 1000) = 8 Then Mill = MyChif(Int(i / 1000)) & "ية آلاف و " Else Mill = MyChif(Int(i / 1000)) & "ة آلاف و " End Select End Select End If '=============================================================================================================================== If Len(i) = 3 Then Select Case i Case 1 To 100: Cent = MyChif(i) Case 101 To 199: Cent = " مائة و " & MyChif(i Mod 100) Case 201 To 299: Cent = " مائتان و " & MyChif(i Mod 100) Case 300 To 999: Select Case (i Mod 100) Case 0: If Format(Mid$(i, 2, 4), "00") = "00" Then Cent = MyChif(Int(i / 100)) & " مائة " Else Cent = MyChif(Int(i / 100)) & " مائة و " Case 1 To 99: Cent = MyChif(Int(i / 100)) & "مائة و " & MyChif(i Mod 100) End Select End Select End If '=============================================================================================================================== J = J + 1 Loop '=============================================================================================================================== Select Case Criteria Case 1: DateToLettre = MyDays(Day(Dat)) & " من " & MyMonths1(Month(Dat)) & " لعام " & Mill & Cent & " ميلادية" Case 2: DateToLettre = MyDays(Day(Dat)) & " من " & MyMonths2(Month(Dat)) & " لعام " & Mill & Cent & " ميلادية" Case 3: DateToLettre = MyDays(Day(Dat)) & " من " & MyMonths3(Month(Dat)) & " لعام " & Mill & Cent & " ميلادية" Case 4: DateToLettre = MyDays(Day(Dat)) & " من " & MyMonths4(Month(Dat)) & " لعام " & Mill & Cent & " هجرية" End Select End Function السلام عليكم ورحمة الله تعالى وبركاته بناء على طلب بعض الإخوة تم تعديل دالة تفقيط التاريخ لتتاسب مع تسميات الشهور في بعض المناطق العربية إضافة إلى تسميات الشهور الهجرية اقتباس من المحترم بن خليفه الجموعي

السلام عليكم ورحمة الله تعالى وبركاته أقدم لكم دالة تفقيط التاريخ لن أطيل عليكم الدالة في المرفق لا تنسونا من خالص دعائكم Function DateToLettre(Dat As Date) As String ' Created By Benkhalifa ' Djemoui Alger: 23/02/2018 Dim MyDays As Variant Dim MyMonths As Variant Dim MyChif As Variant Dim Cent As String Dim Mill As String Dim i, J As Byte: J = 0 '=============================================================================================================================== MyDays = Array("اليوم الأول", "اليوم الثاني", "اليوم الثالث", _ "اليوم الرابع", "اليوم الخامس", "اليوم السادس", _ "اليوم السابع", "اليوم الثامن", "اليوم التاسع", _ "اليوم العاشر", "اليوم الحادي عشر", "اليوم الثاني عشر", _ "ليوم الثالث عشر", "اليوم الرابع عشر", "اليوم الخامس عشر", _ "اليوم السادس عشر", "اليوم السابع عشر", "اليوم الثامن عشر", _ "اليوم التاسع عشر", "اليوم العشرون", "اليوم الواحد و العشرون", _ "اليوم الثاني و العشرون", "اليوم الثالث و العشرون", "اليوم الرابع و العشرون", _ "ليوم الخامس و العشرون", "اليوم السادس و العشرون", "اليوم السابع و العشرون", _ "اليوم الثامن و العشرون", "اليوم التاسع و العشرون", "اليوم الثلاثون", _ "اليوم الواحد و الثلاثون") '=============================================================================================================================== MyMonths = Array("شهر يناير", "شهر فبراير", "شهر مارس", _ "شهر أبريل", "شهر مايو", "شهر يونيو", _ "شهر يوليو", "شهر اغسطس", "شهر سبتمبر", _ "شهر أكتوبر", "شهر نوفمبر", "شهر ديسمبر") '=============================================================================================================================== MyChif = Array("صفر", "واحد", "إثنان", "ثلاث", "أربع", "خمس", "ست", "سبع", "ثمان", "تسع", _ "عشرة", "إحدى عشر", "إثنى عشر", "ثلاثة عشر", "أربعة عشر", "خمسة عشر", "ستة عشر", "سبعة عشر", "ثمانية عشر", _ "تسعة عشر", "عشرون", "واحد و عشرون", "إثنان و عشرون", "ثلاثة و عشرون", "أربعة و عشرون", "خمسة و عشرون", "ستة و عشرون", _ "سبعة و عشرون", "ثمانية و عشرون", "تسعة عشرون", "ثلاثون", "واحد و ثلاثون", "إثنان و ثلاثون", "ثلاثة و ثلاثون", "أربعة و ثلاثون", _ "خمسة و ثلاثون", "ستة و ثلاثون", "سبعة و ثلاثون", "ثمانية و ثلاثون", "تسعة و ثلاثون", "أربعون", _ "واحد و أربعون", "إثنان و أربعون", "ثلاثة و أربعون", "أربعة و أربعون", "خمسة و أربعون", "ستة و أربعون", _ "سبعة و أربعون", "ثمانية و أربعون", "تسعة و أربعون", "خمسون", "واحد و خمسون", "إثنان و خمسون", "ثلاثة و خمسون", "أربعة و خمسون", _ "خمسة و خمسون", "ستة و خمسون", "سبعة و خمسون", "ثمانية و خمسون", "تسعة و خمسون", "ستون", "واحد و ستون", _ "إثنان و ستون", "ثلاثة و ستون", "أربعة و ستون", "خمسة و ستون", "ستة ستون", _ "سبعة و ستون", "ثمانية و ستون", "تسعة و ستون", "سبعون", "واحد و سبعون", "إثنان و سبعون", "ثلاثة و سبعون", _ "أربع و سبعون", "خمس و سبعون", "ستة و سبعون", "سبعة و سبعون", "ثمانية و سبعون", "تسعة و سبعون", "ثمانون", "واحد و ثمانون", _ "إثنان و ثمانون", "ثلاث و ثمانون", "أربعة و ثمانون", "خمسة و ثمانون", "ستة و ثمانون", "سبعة و ثمانون", _ "ثمانية و ثمانون", "تسع و ثمانون", "تسعون", "واحد و تسعون", "إثنان و تسعون", "ثلاثة و تسعون", "أربعة و تسعون", _ "خمسة و تسعون", "تسعون", "سبعة و تسعون", "ثمانية و تسعون", "تسعة و تسعون", " مائة ") '=============================================================================================================================== Do While J < 2 i = Mid$(Year(Dat), J + 1, 4) '=============================================================================================================================== If Len(i) = 4 Then Select Case i Case 1 To 999: Mill = MyChif(i) Case 1000 To 9999: Select Case Int(i / 1000) Case 1: If Format(Mid$(i, 2, 4), "000") = "000" Then Mill = " ألف" Else: Mill = " ألف و " Case 2: If Format(Mid$(i, 2, 4), "000") = "000" Then Mill = " ألفان" Else Mill = " ألفان و " Case 3 To 10: If Format(Mid$(i, 2, 4), "000") = "000" Then Mill = MyChif(Int(i / 1000)) & " آلاف" Else If Int(i / 1000) = 8 Then Mill = MyChif(Int(i / 1000)) & "ية آلاف و " Else Mill = MyChif(Int(i / 1000)) & "ة آلاف و " End Select End Select End If '=============================================================================================================================== If Len(i) = 3 Then Select Case i Case 1 To 100: Cent = MyChif(i) Case 101 To 199: Cent = " مائة و " & MyChif(i Mod 100) Case 201 To 299: Cent = " مائتان و " & MyChif(i Mod 100) Case 300 To 999: Select Case (i Mod 100) Case 0: If Format(Mid$(i, 2, 4), "00") = "00" Then Cent = MyChif(Int(i / 100)) & " مائة " Else Cent = MyChif(Int(i / 100)) & " مائة و " Case 1 To 99: Cent = MyChif(Int(i / 100)) & "مائة و " & MyChif(i Mod 100) End Select End Select End If '=============================================================================================================================== J = J + 1 Loop '=============================================================================================================================== DateToLettre = MyDays(Day(Dat) - 1) & " من " & MyMonths(Month(Dat) - 1) & " عام " & Mill & Cent End Function منقول لنشر العلم جزى الله .. المحترم الخلوق بن خليفه الجموعي بكل خير دالة تفقيط التاريخ.rar

هل يمكن ان تضع الكود في ملف لاني لم اعرف تفعيله و جزاك الله خيرا

ويتبقى فقط الإعلان declare عن الدالة في الموديول ( اقتباس ) من فضلك ضع الكود في حلته الجديده

جزاك الله خيرا استاذ محمد صالح شعله نشاط يكتبه الله في كفه حسناتك وبعد Private Sub Worksheet_SelectionChange(ByVal Target As Range) If Target Then ChaingeLanguage "Arabic" 'Else 'ChaingeLanguage "English" End If End Sub هل التغيير الذي حدث يؤثر على الكود لاني عايز الملف كله يكتب بالعربي

ده الشغل واللا بلاش .. يحفظك ربنا استاذ محمد صالح

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

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

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

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

جزاك الله خيرا وبارك فيك استاذ محمد =============== تظهر هذه الرساله عند فتح الملف

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

للرفع

صدقت فلا خير في كاتم علم ان شاء الله

يحفظكم الخالق .. استاذ ايهاب ولكن عندما اجعل عمود الفصول المراد فلترته بالمعادله مرن واضع =OFFSET(Main!$K$9;0;0;COUNTA(Main!$K$9:$K$6007);1) لاتعمل مالفرق بين الشرطه المائله ناحيه اليمين والشرطه المائله ناحيه اليسار من حيث تأثيرها على المعادله ؟