نجوم المشاركات

جزاكم الله كل خير جميعا. وأحب أن أبشركم بأني في طريقي للانتهاء من برمجة أقصر واسرع كود للتفقيط (54 سطر برمجي) متعدد اللغات ويمكن تخصيصه لجميع العملات وموافق لقواعد اللغة العربية واللغة الإنجليزية. ولكن نظرا لاهتمامي بلغة الويب قمت بعمله أولا في هذه الصفحة أونلاين https://www.mr-mas.com/p/tafqeet.html وجاري تحويله ليعمل على فيجوال بيسك للتطبيقات vba تابعونا

تفضل هذا التعديل اخي الكريم لكن للعلم و الإحاطة !!! لا تقم بنسخ و لصق البيانات لعمل اختبار للترقم ! المرفق الحالي عملية الترقيم تتم بعد تحديث حقل الصنف من خلال الدالة التالية number = Nz(DMax("[number]", "[details]", "[sale_id]=[Forms]![sale]![sale_id]"), 0) + 1 يتم استدعاء اكبر قيمة في عمود التسلسل المسمى number بعد جلب القيمة يتم اضافة رقم 1 للنتيجة لتعطي الرقم التالي المفترض اذا فنسخ و لصق البيانات لن يجعل الكود يعمل copy.accdb

همممم ليش كل هذه الاسطر !! اذا كنت عامل علاقات بين الجداول ، وكنت مختار "حذف البيانات المرتبطة" (الاختيار الثالث في المربع الاحمر والذي عليه السهم) : يكفي ان تحذف بيانات الجدول الرئيسي فقط ، وبقية الجداول سوف تحذف بياناتها تلقائيا 🙂 يعني حسب اسماء الجداول في الصورة ، لو حذفنا بيانات الجدول tbl_Persone_Static (الجدول الذي حوله المربع الاحمر) ، فتلقائيا بيانات جميع الجداول المرتبطة به سوف يتم حذفها ، هذه ميزة وعمل الاختيار رقم 3 🙂 جعفر

تفضل =IF(WEEKDAY(P2)=5;P2+2;P2+1) Book1 (1).xlsx

اتفضل يابو عبدالرحمن فقط حدد اسماء الجداول الي تحتاج تحذف بياناتها On Error GoTo errorhandle DoCmd.SetWarnings False DoCmd.RunSQL "DELETE FROM " & "TableName1" DoCmd.RunSQL "DELETE FROM " & "TableName2" DoCmd.RunSQL "DELETE FROM " & "TableName3" DoCmd.RunSQL "DELETE FROM " & "TableName4" DoCmd.SetWarnings True MsgBox "تم افراغ الجداول بنجاح" errorhandleexit: Exit Sub errorhandle: MsgBox Err.Description Resume errorhandleexit

السلام عليكم ورحمة الله وبركاته كل عام وانتم بخير اطلب المسامحة ممن راسلني ولم يجد رد مني هديتي لكم بعد هذه الغيبة Option Explicit '========================================================" ' بسم الله الرحمن الرحيم " '========================================================" ' (دالة تحويل الرقم الى نص باللغة العربية (تفقيط " ' kh_TextNum " '========================================================" 'Num الرقم " '========================================================" 'sex جنس العملة " 'FALSE ( فارغ او صفر مذكر ) " 'TRUE ( أو اي رقم غير الصفر مؤنث ) " '========================================================" 'sNameCurr اسم العملة الرئيسية مفرد " 'pNameCurr اسم العملة الرئيسية جمع " 'NameCurrDec اسم العملة الكسرية " 'Decimal_Count طول الكسر افتراضـياً : بدون اظهار الكسر " '===============================================================================================================================================" 'xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx" '===============================================================================================================================================" ' ملاحظات ' (اولاً : العملة الرئيسية مثنى (يقوم بها الكود تلقائيا ' مع ملاحظة اذا اسم العملة ينتهي بالتاء المربوطة ' يجب ان يكتب كذلك وليس بالهاء ' ----------------------- ' ثانياً : اذا كانت العملة الرئيسية مفرد فارغاً تعتبر ' اسماء العملات (الجمع والكسري) فارغة تلقائيا ' ----------------------- 'ثالثاً : الكلمة الابتدائية بامكانك تغييرها او تجعلها فارغة Private Const MyBegTx As String = "فقط " ' "" ' ----------------------- ' MyTNum رابعا : يمكنك التغيير (اضافة,حذف,تحرير) في الثابت ' للفئات الصفرية للرقم ادناه Private Const MyTNum As String = "ألف-آلاف/مليون-ملايين/مليار-مليارات/بليون-بلايين/بليار-بليارات/ترليون-ترليونات/تريليار-تريليارات/كدرليون-كدرليونات" '===============================================================================================================================================" 'xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx" '===============================================================================================================================================" Function kh_TextNum(Num As String, Optional sex As Boolean = False, Optional sNameCurr As String = "", Optional pNameCurr As String = "", Optional NameCurrDec As String = "", Optional Decimal_Count As Byte = 2) As String Dim Spp, zt Dim i%, ii%, pr% Dim MyMid$, nCurr$, Txt$, Txt1$, Txt2$ '====================================== If Not IsNumeric(Num) Then GoTo kh_Exit Spp = Split("/" & MyTNum, "/") ii = UBound(Spp) If Num < 0 Then Num = Abs(Num) '====================================== If Val(Num) > Val(String((ii + 1) * 3, "9") & ".999") Then GoTo kh_Exit '====================================== nCurr = sNameCurr & "-" & IIf(pNameCurr = "", sNameCurr, IIf(sNameCurr = "", "", pNameCurr)) '====================================== Txt1 = Format(Num, String((ii + 1) * 3, "0") & ".000") For i = 0 To ii MyMid = Mid(Txt1, (i * 3) + 1, 3) If MyMid Then zt = Mid(Txt1, (i * 3) + 4, Len(Txt1)) zt = IIf(ii - i, Int(zt), zt) Txt2 = IIf(ii - i, Trim(Spp(ii - i)), nCurr) pr = 1 + IIf(ii - i, 1, CInt(sex)) Txt = Txt & IIf(Len(Txt), " و", "") & kh_nText(MyMid, Txt2, pr, zt, CBool(sNameCurr <> "")) End If If i = ii Then If MyMid = 0 Then Txt = Txt & IIf(Len(Txt), " ", "صفر ") & sNameCurr Next '====================================== Txt = MyBegTx & Txt & kh_dText(Num, sNameCurr, NameCurrDec, Decimal_Count) '====================================== kh_Exit: kh_TextNum = Trim(Txt) End Function ' معالجة العدد من 1 الى 999 لكل فئات الرقم Private Function kh_nText(ByVal iNum As String, ByVal oMm As String, ByVal ibs As Integer, ByVal z As Boolean, ByVal tCu As Boolean) As String Dim Sp Dim Num1%, Num2%, Num3% Dim oM$, S$, S1$, nT$, nT0$, nT1$, nT2$ '====================================== Sp = Split("واحد,إحدى,اثنتان,ثلاث,أربع,خمس,ست,سبع,ثمان,تسع,عشر,إحدى ,اثنتا ", ",") '====================================== If ibs Then S = "ة": Sp(1) = Sp(0): Sp(2) = "اثنان": Sp(11) = "أحد ": Sp(12) = "اثنا " Else S1 = "ة" oM = Trim(Split(oMm, "-")(0)) '====================================== Num1 = Left(iNum, 1) Num2 = Right(iNum, 2) Select Case Num1 Case 1: nT0 = "مائة" Case 2: nT0 = "مائتا" & IIf(ibs = 2, IIf(Num2 < 3, "", "ن"), IIf(Num2 = 0 And oM <> "", "", "ن")) Case 3 To 9: nT0 = Sp(Num1) & "مائة" End Select '========================================= Num1 = Right(iNum, 2) Select Case Num1 Case 1, 2: If nT0 <> "" Then If ibs = 2 Then nT0 = nT0 & " " & oM Case 11 To 99: If oM <> "" Then If ibs Then If z Then oM = oM & "اً" End Select '----------------------------------------- Select Case Num1 Case 1 nT = IIf(oM = "", Sp(0) & S1, oM) oM = IIf(ibs <> 2 And oM <> "", Sp(0) & S1, "") Case 2 nT = IIf(oM = "", Sp(Num1), Replace(oM, "ة", "ت") & IIf(z = 0 And ibs = 2 And tCu, "ا", "ان")) oM = IIf(ibs <> 2 And oM <> "", Sp(Num1), "") Case 3 To 10 oM = Trim(Split(oMm, "-")(1)) nT = Sp(Num1) & S Case 11, 12 nT = Sp(Num1) & Sp(10) & S1 Case 13 To 19 nT = Sp(Num1 - 10) & S & " " & Sp(10) & S1 Case 20 To 99 Num2 = Right(Num1, 1) Num3 = Left(Num1, 1) If Num3 = 2 Then nT1 = "عشرون" Else nT1 = Sp(Num3) & "ون" nT2 = Sp(Num2) & IIf(Num2 > 2, S, "") & " و" & nT1 If Num2 = 0 Then nT2 = nT1 nT = nT2 End Select '====================================== S = IIf(nT = "" Or iNum < 100, "", " و") nT = Replace(nT, Sp(8) & "ة", Sp(8) & "ية") kh_nText = Trim(nT0 & S & nT & " " & oM) '====================================== End Function ' معالجة الكسر Private Function kh_dText(ByVal dNum As String, ByVal NCur As String, ByVal Ndec As String, ByVal co As Byte) As String Dim Td$, Td1$ On Error GoTo 1 If NCur = "" Then Ndec = "" Td = Format(Round(CCur(dNum - Int(dNum)), co), "0." & String(co, "0")) If Td = 0 Or Td = 1 Then Td1 = "": GoTo 1 If Len(Ndec) Then Ndec = " " & Ndec: Td1 = Td * CVar("1" & String(co, "0")) Else Ndec = " " & NCur: Td1 = Td Td1 = " و " & Chr(40) & Td1 & Chr(41) & Ndec 1: kh_dText = Td1 End Function دالة تحويل الرقم الى نص عربي.rar ================================================= الملف المعدل: هذا المرفق بامكانية تفقيط الكسر وامكانية ادخال كلمة نهاية النص دالة تحويل الرقم الى نص عربي.rar ================================================= رابط مباشر للملف

جزاكم الله كل خير جميعا. وأحب أن أبشركم بأني في طريقي للانتهاء من برمجة أقصر واسرع كود للتفقيط (54 سطر برمجي) متعدد اللغات ويمكن تخصيصه لجميع العملات. ولكن نظرا لاهتمامي بلغة الويب قمت بعمله أولا في هذه الصفحة أونلاين https://www.mr-mas.com/p/tafqeet.html وجاري تحويله ليعمل على فيجوال بيسك للتطبيقات vba تابعونا

جزاكم الله كل خير جميعا. وأحب أن أبشركم بأني في طريقي للانتهاء من برمجة أقصر واسرع كود للتفقيط (54 سطر برمجي) متعدد اللغات ويمكن تخصيصه لجميع العملات. ولكن نظرا لاهتمامي بلغة الويب قمت بعمله أولا في هذه الصفحة أونلاين https://www.mr-mas.com/p/tafqeet.html وجاري تحويله ليعمل على فيجوال بيسك للتطبيقات vba تابعونا

تفضل اخي الكريم العلاقات.accdb

من الأفضل ارفاق نموذج لطلبك للتعديل عليه

تفضل اخي الكريم wesam.rar

اخي الكريم الاجازة السنوية : 30 يوم في الشهر : (30/12) يوم في اليوم : (30/(30/12)) يوم تاريخ اخر اجازة : 01/01/2019 المعادلة كالتالي X = "تاريخ اخر اجازة" مدة العمل الأيام DateDiff("D"; [x] ;now()) الشهور DateDiff("M"; [x] ;now()) السنوات DateDiff("YYYY"; [x] ;now()) ===================================== المعادلة الاجازة المستحقة حسب اشهر العمل الفعلية هي DateDiff("M";[X];Now()) * (30/12) الاجازة المستحقة حسب أيام العمل الفعلية هي DateDiff("D";[X];Now()) * ((30/12)/30) الاجازة المستحقة حسب سنوات العمل الفعلية هي DateDiff("YYYY";[X];Now()) * 30

بارك الله فيك أستاذنا الفاضل سليم وبعد إذنك لإثراء الموضوع يكون الاختيار النوع والقسم من الخلايا H2 و I2 ويتم كتابة الكود التالي في الخلية G7 =I2 وعند النقر على Run وكانت الخلية I2 فارغة تظهر رسالة " يجب إدخال القسم في الخلية و يتوقف عمل الكود Moujahed 2013.xlsm

جرب هذا الملف في حال تريد كل الطلاب من نفس الصف (ذكر + أنثى) اترك الخلية H2 فارغة واضغط الزر Run Moujahed 2013.xlsm

السلام عليكم مرحبا اخي الكريم بالنسبة فكرة عمل نسخة احتياطية للبرنامج لا بد ان تكون دقيق في هذه العملية اولاً : هل المسار ثايت ام يحدده المستخدم في كل مرة اذا كان المسار ثابت فيجب ان يكون دقيق جداً فمثلا انت تكتب في المسار "نسخ احتياطى" ولا يوجد مجلد بهذا الاسم ولكن الاسم الموجود "تسخة احتياطية" وهناك اكثر من خطأ في المسار لديك وانصحك وبشدة ان تستخدم كلمات انجليزية ( علماً بأني ضعيف في الانجليزي لكن من خلال المشاكل التي لا حصر لها التي واجهتني في عملي اضطررت لحفظ بعض الكلمات والاستفادة من خدمة جوجل للترجمه في اوقات كثيرة ) ثانياً : هل النسخ الاحتياطية للجداول فقط ام للبرانامج بالكامل اذا كانت للجداول فقط فستحتاج الى تحديد الجداول مسبقاً وهذا والحمد لله لم نتعرض له لانه يحتاج الى كثير من الاكواد ثالثاً : عملية الاسترجاع يتم تحديد ذلك بناءا على بند ثانياً فانت لم تقم بنسخ الجداول وهذ افضل وبما ان النسخ الاحتياطي تم لكامل البرنامج فما عليك الا نسخ Copy من مجلد النسخ الاحتياطي الى مكان البرنامج الاصلي ولصق Paste وتغيير اسم البرنامج وحذف التاريخ والوقت وارى والله اعلم ان هذا الاختيار به فائدة كبيرة فقد تكون قاعدة البيانات الحالية بها مشاكل فتقوم بنسخ الاحتياطية الخالية من المشاكل وتكمل عملك بنجاح تم تعديل الاكواد والمسارات وسيتم باذن الله عمل نسخة احتياطية لكامل البرنامج حسب تاريخ اليوم في مجلد اليوم الخاص به ( السبت - الاحد ... الجمعه ) اوراق دفع.rar تحياتي

جرب هذا تم عمل نطاقين أحدهما A والآخر B وهما وموجودين في الخلايا BA2:BB7 ، BC2:BC7 واستخدام دالة VLOOKUP رصد .xlsx

السلام عليكم أخي woowoow ، بارك الله فيك وبعد إذن أخي أمير عاطف ، أود المشاركة هنا 1. حيث أن المتغيرين a,b درجة المدير والموجه تسمحان بالقيمة الفارغة Null فهما متغيران Variant 2. ربما تستغربان الحل ، فإنه لا حل لحساب المتوسط لهذه المسألة التي تبدو غاية في البساطة إلا الحل المعقد التالي وهو : الوسط الحسابي = (Nz(Nz(a, b), 0) + Nz(Nz(b, a), 0)) / 2 واسمحا لي أن أشرح لكما كيف تعمل المعادلة السابقة إذا كانت a = null فإننا نجعل قيمة b =a وإذا كانت قيمة b = null فإننا نجعل النتيجة 0 وهكذا للجزء الثاني ولكن بعكس المتغيرات . مع الاحترام والتقدير