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

السلام عليكم هذا بمناسبة عيد المرأة عيد المرأة.accdb

السلام عليكم أخي الكريم أرجو أن يكون الحل مناسباً التفقيط: تم استخدام كود التفقيط مع التعديل التقدير: تم استخدام دالة IF المركبة =IF(C9>84.5;"ممتاز";IF(C9>74.5;"جيد جداً";IF(C9>64.5;"جيد";IF(C9>49.5;"مقبول";"ضعيف")))) الترتيب: تم استخدام دالة RANK =RANK(C9;$C$9:$C$48;0) والله الموفق نقبل تحياتي العطرة والسىلام عليكم تقييم الصف السادس AY.xlsm

السلام عليكم أخي الكريم تفضل جواب طلبك باستخدام معادلة SUMIFS وإجراء تغييرات للحصول على نتيجة مقبولة =SUM(SUMIFS($B$2:$B$72;$C$2:$C$72;">="&$J$1;$C$2:$C$72;"<="&$J$2);SUMIFS($D$2:$D$72;$E$2:$E$72;">="&$J$1;$E$2:$E$72;"<="&$J$2)) حياكم الله والسلام عليكم دفعات الاشهر.xlsx

المعادلة في الخلية الاولي فقطتختلف عن بقية الخلايا تفضل كل الأيام عدا الجمعة.xlsx

السلام عليكم 🙂 نعمل البرنامج ، ثم نقسمه الى قسمين ، FE الواجهة و BE الجداول ، ولما نعطيه للمستخدم ، نربط الجداول بمسار خاص به ، ويعمل البرنامج. ولما المستخدم يحتاج الى تعديل/اضافات ، ويرسل لنا نسخته بالايميل (انا ممكن اكون مسافر وبعيد عن نسختي) ، فيجب علينا ان نغير مسار الجداول ليتناسب مع مجلدات الكمبيوتر عندنا ، ولما ننتهي من التعديل ، نرسله بالايميل ، وهناك يجب على المستخدم ان يغير المسار الى ذلك الذي به BE الاصل 🙂 المشكلة انه: 1. بعض الاوقات نكون قد وضعنا الـ BE في مكان لا يجب ان يعرفه المستخدم ، فلا نريد تدخل منه لهذا التغيير ، 2. بعض الاوقات المستخدم لا يعرف مكان الـ BE اصلا ، 3. وبعض الاوقات ، المستخدم لا يكون فني ليعرف كيف يختار مكان الـ BE 🙂 صادفتني هذه المشكلة مراراً ، ومرة دفعت الثمن غالي لما ربطوه بالـ BE الغلط ، ربطوه بنسخة الـ Backup بدل عن النسخة الاصل 😁 الى ان اهتديت الى هذه الطريقة 🙂 الفكرة هي عبارة عن اضافة جدول tbl_ReLink_To_Original في الـ FE فيه سجلين ، سجل يحتوي على مسار BE المستخدم ، وسجل يحتوي على مسار BE المبرمج ، وبدل هذا الجدول ، ممكن ان نضع ملف نص txt في مجلد FE ، ونكتب فيهم السجلين ، ثم نقرأهم ، ولكن الجداول في الـ FE تناسبني اكثر ، فإستعملتها 🙂 1. لمعرفة مسار BE المستخدم: . . ثم ننسخه من (1) جدول MSysObjects الى السجل الاول (Seq = 1) في جدولنا (2) tbl_ReLink_To_Original . ثم في السجل الثاني (Seq = 2) ، نكتب مسار الـ BE حسب مجلدات الكمبيوتر عندنا (3) . طريقة العمل: نعمل ماكرو Macro باسم Autoexec ، والذي يقوم الاكسس بفتحه وتنفيذ اوامره اول ما يفتح البرنامج ، 1. نقوم بتشغيل الكود الذي سيربط الـ BE الى المسار الصحيح للمستخدم (اما المبرمج فلا يسنخدم هذا الماكرو ، وانما يدخل في البرنامج بمسك مفتاح الشفت) ، 2. اذا لم يحصل البرنامج على المسار الصحيح ، فيجب ان نخبره ان يعطينا نافذة نختار منها المسار الصحيح ، وهناك عدة طرق ، واخترت طريقتي هنا ، 3.4.5.7.8 هذه لإخفاء جميع كائنات البرنامج من جداول واستعلامات ونماذج وماكرو وتقارير ووحدات نمطية ، وتوسيع البرنامج لحجم الشاشة (فلا نحتاج ان نجعل النموذج منبثق ، والذي به الكثير من المشاكل) ، 5. فتح النموذج الاول من البرنامج ، . هذه هي الوحدة النمطية التي تقوم بالعمل (1) اعلاه : Public Function f_ReLink_To_Original(Optional Seq As Integer = 1) 'On Error GoTo err_f_ReLink_To_Original On Error GoTo Exit_f_ReLink_To_Original ' ' The client have his own path to the linked BE tables, ' yet for Development when we want to do change and modifications on the FE, ' we want to link this FE to our local BE tables, for testing, ' and we are done, we will send this FE back to the client, which will have our BE path!! ' ' Although the FE have a code on startup, which will prompt for the new BE path, but not all clients know how to use it!! ' So I added a table tbl_ReLink_To_Original to the FE, and the path to the client BE path, as Seq = 1 , ' and for the Developer BE, the Seq is 2 or other numbers. ' ' for the Development BE path, we call this Function, for the immediate window: ' ?f_ReLink_To_Original(2) ' ' or from a normal Event: ' Call Call f_ReLink_To_Original(2) ' ' and enter the DB with Shift key, ' ' and when the FE goes to the client, this Function will call Seq = 1 by default, thus returning their correct Path. ' ' ' by jjafferr ' ' v1. 24-Feb-2020 ' Dim db As dao.Database Dim tdf As dao.TableDef Dim ConnectionString As String, Linked_Connection As String Set db = CurrentDb 'which BackEnd the user selected ConnectionString = DLookup("[DB_Path]", "tbl_ReLink_To_Original", "[Seq]=" & Seq) 'the existing BackEnd Linked_Connection = DLookup("[Database]", "MSysObjects", "[flags] = 2097152") 'if the existing BackEnd = User Selected, then No need to connect again, just exit If ConnectionString = Linked_Connection Then GoTo Exit_f_ReLink_To_Original For Each tdf In db.TableDefs ' Only make a change if the table is a linked table If Len(tdf.Connect) Then tdf.Connect = ";DATABASE=" & ConnectionString tdf.RefreshLink End If Next Exit_f_ReLink_To_Original: Exit Function err_f_ReLink_To_Original: If Err.Number = 3170 Then 'MsgBox "رجاء التاكد من مسار القاعدة الموجوده في الجدول" & vbCrLf & "tbl_ReLink_To_Original" 'Resume Next Resume Exit_f_ReLink_To_Original Else MsgBox Err.Number & vbCrLf & Err.Description Resume Exit_f_ReLink_To_Original End If End Function . اما للمبرمج ، فيجب عليه ان يدخل الكود ويكتب (لاحظوا اننا استخدمنا الرقم Seq = 2 ، ليشير الى السجل الثاني في الجدول ، المشير الى مسار الـ BE حسب مجلدات الكمبيوتر عندنا (3) : من نافذة الكود السفلى: immediate ?f_ReLink_To_Original(2) او من اي حدث Call f_ReLink_To_Original(2) . واذا اردت الاستفادة من هذه الطريقة لبرامجك ، فيجب عليك استيراد هذه الكائنات الى برنامجك (مع الاخذ في الاعتبار تغيير اسم النموذج في ماكرو autoexec ) : جعفر Relink Tables.zip

السلام عليكم 🙂 ابو عبدالرحمن ، يا ريت تعطينا مرفق فيه مجموعة بيانات في الاكسس ، والطريقة التي تريد البيانات تكون في الاكسل ، لأني مو قادر افهم المطلوب من المرفقات وكل مرفق فيه جزئية من الموضوع !! جعفر

السلام عليكم مبدئيا الملف المرفق لتصدير الجدول الى اكسيل انظر للمرفق واعطنا ملاحظاتك Database1.accdb

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

لا وانت الصادق ، اضطر افكر بهذه الطرق لإنجاز عملي 🙂 لهذا السبب ترى انه ما عندي مشاركات في اخفاء خلفية الاكسس ، او طرق الحمايات ، او ... ، بينما تخصصي في التعامل مع البيانات 🙂 اخوي موسى ، اليك آخر تحديث للموصوع ، وطريقة عملي: لما استلم برنامج جديد مجزأ الى واجهة وخلفية: في الواجهة FE ، امسك مفتاح الشفت وافتح الواجهة في وضع التصميم ، ثم اضع الكائنات التالية: الجدول tbl_ReLink_To_Original (تم عمل تغييرات على الجدول في المرفق) ، مع حذف جميع بياناته ، الماكرو Autoexec ، مع تغيير اسم اول نموذج يتم فتحه ، الوحدة النمطية basJStreetAccessRelinker وبدون المساس بها ، الوحدة النمطية m_Arc_Subs ، مع مراعاة استخدام النسخة الاحدث من الدالة f_ReLink_To_Original (انظر الكود في الاسفل) ، واضافة الدالة الجديدة f_Original_DB_Path_Append ، الدالة الجديدة f_Original_DB_Path_Append تقوم بجميع الخطوات اليدوية التي شرحتها في اول مشاركة ، وتقوم بإدخال مسارات الجداول المرتبطة في VBA في نافذة immediate اكتب (لاحظ ان علامة الاستفهام بالانجيزي) ?f_Original_DB_Path_Append اغلق البرنامج بعد حفظ كل شيء اعلاه ، افتح البرنامج بدون مسك مفتاح الشفت ، وسيسألني البرنامج عن مسار الجداول ، واخبره عن المسار ، ويشتغل البرنامج بالبيانات ، اقوم بجميع التعديلات/الزيادة المطلوبة ، وبعد كل تعديل اغلق البرنامج ، ثم استخدم البرنامج في الرابط التالي ، حتى ينظف برنامجي ويعمل لي نسخة احتياطية (وكثر ما اقول ، ما اوفي البرنامج حقه ، فكثير من الاحيان وبعد ايام او اشهر ، اضطر للرجوع الى احد النسخ القديمة والذي كان فيه كود قديم يشتغل ، ولكني استبدلته بكود جديد وظهر به اخطاء) : وفي النهاية اضغط البرنامج وارسله لصاحبه ، لما صاحبه يفتحه ، تلقائيا البرنامج يفتح بالطريقة العادية وبدون تدخل المستخدم في اي شيء 🙂 هذا هو الكود المعدل: Public Function f_ReLink_To_Original(Optional Seq As Integer = 1) On Error GoTo err_f_ReLink_To_Original ' ' this Function runs from startup, from AutoExec Macro. ' ' The client have his own path to the linked BE tables, ' yet for Development when we want to do changes and modifications on the FE, ' we want to link this FE to our local BE tables, for testing, ' and when we are done, we will send this FE back to the client, which will have our BE path, and that is the problem !! ' ' The Developer: ' since this Function runs from startup, but will NOT find the client BE, ' then the startup will run the Function jstCheckTableLinks_Full, which will prompt for the new BE path, and Link the FE to the BE. ' ' So I added a table tbl_ReLink_To_Original to the FE, and the path to the client BE path, as Seq = 1 , ' and for the Developer BE, the Seq is Not 1. ' ' for the Development BE path, we can run the DB normally, ' and the Function jstCheckTableLinks_Full will prompt asking for the BE path (since the DB will NOT find the BE from this Function), ' ' Or, if entered the DB while holding the Shift key, we can: ' call this Function, from the immediate window: ' ?f_ReLink_To_Original(2) ' ' or call this Function from any Event: ' Call f_ReLink_To_Original(2) ' ' ' The Client: ' And when the FE goes to the client, this Function will call Seq = 1 by default, thus returning their correct Path. ' ' ' by jjafferr ' ' v1.0, 24-Feb-2020 , One BE ' v2.0, 10-Jul-2020 , Multiple BEs ' v2.1, 13-Jul-2020 , Multiple BEs, but each table should be connected to it's owen BE !! ' , the table might be in different BE, so this way we connect it to the right BE ' Dim db As DAO.Database Dim tdf As DAO.TableDef Dim rst As DAO.Recordset Set db = CurrentDb 'assuming it is the Client, loop through his BE path Set rst = CurrentDb.OpenRecordset("Select [tbl_Name], [DB_Path] From tbl_ReLink_To_Original Where [Seq]=" & Seq) For Each tdf In db.TableDefs ' Only make a change if the table is a linked table If Len(tdf.Connect) Then rst.FindFirst "[tbl_Name] = '" & tdf.Name & "'" tdf.Connect = ";DATABASE=" & rst![DB_Path] tdf.RefreshLink ' if the table is not found in the DB Path, the Function will generate error 3011 End If 'Len Next Exit_f_ReLink_To_Original: rst.Close: Set rst = Nothing Exit Function err_f_ReLink_To_Original: If Err.Number = 3170 Then 'MsgBox "رجاء التاكد من مسار القاعدة الموجوده في الجدول" & vbCrLf & "tbl_ReLink_To_Original" 'Resume Next Resume Exit_f_ReLink_To_Original ElseIf Err.Number = 3011 Or Err.Number = 3044 Then 'this Table belonges to another DB, ignore, 'as the other DB Path will be checked too Resume Next Else MsgBox Err.Number & vbCrLf & Err.Description Resume Exit_f_ReLink_To_Original End If End Function Public Function f_Original_DB_Path_Append() Dim mySQL As String DoCmd.SetWarnings False mySQL = "UPDATE tbl_ReLink_To_Original SET Seq = 5, Remarks = 'A different BE Path was added' WHERE Seq=1" DoCmd.RunSQL mySQL mySQL = "INSERT INTO tbl_ReLink_To_Original ( DB_Path, tbl_Name, Seq, Remarks )" mySQL = mySQL & " SELECT Database, Name, 1, 'Client'" mySQL = mySQL & " FROM MSysObjects WHERE Flags = 2097152 ORDER BY Database" DoCmd.RunSQL mySQL DoCmd.SetWarnings True End Function جعفر Relink Tables.zip

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

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

ابشر طلبك قيد التنفيذ ...

السلام عليكم جرب المرفق تقييم الصف السادس.xls

جرب .... واعلمنا .... قد يكون دخولي قليلا هذه الفترة .... عند وجود ملاحظات حاول طرحها ربما تجد من هو متواجد بكثرة الاجابة ... ‏‏‏‏‏‏‏‏برنامج الاحتياطي 2022 - Kan.accdb

شكرا اخي @محمد حسن المحمد شكرا علي مشاعرك الطيبة كلنا نكمل بعضنا البعض وفوق كل ذي علم عليم شكرا اخي @Ashraf Atteya Abo Zaidعلي مشاعرك الطيبة واسال الله ان نكون عند حسن ظنكم بنا

تفضل استاذ احمد..والله يعين الجدول على هذا الحقل المحسوب الدرجه.accdb

السلام عليكم أخي الكريم لعلي فهمت سؤالك تريد حساب إجمالي الوزن الصافي حسب رقم كل بوليصة الحل باستخدام دالة SUMIF كما يلي: =SUMIF($D$3:$E$196;H12;$E$3:$E$196) واسحب نزولاً ليشمل كل أرقام البوليصة. مثال.xlsx

السلام عليكم أخي الكريم بعد دراسة الموضوع الذي عرضته يحتاج عند التفكير للوهلة الأولى لإضافة الشهور الناتجة إلى عدد الشهور الأصلية وبذلك قد يكون عندك كم هائل من الأشهر حسب أي من الشرطين ولذلك أحببت أن أضيف تحقق أي من الشرطين لتاريخ نهاية الخدمة المبين لديك في الملف ثم استخدام معادلة Datedif لحساب الفرق بين تاريخ بدء الخدمة والتاريخ الناتج عن أحد الشرطين كما يلي: حيث تم الضرب بعدد السنوات بغضّ النظر عن الأشهر حتى لو بلغت 11 شهراً و 30يوماً. =IF(B13<=10;$E$11+(60*E13);$E$11+(90*E13)) حساب نتيجة اقدمية.xlsx

تم دمج الموضوعين

اخوي ابو نزار انت خالفت قواعد المشاركة في اكثر من بند ، والمخالفة في بند واحد يستحق اغلاق الموضع ونحن في الغالب نغض الطرف عن بعض المخالفات اولا انك فتحت موضوع جديد وهو اصلا امتداد لموضوعك السابق .. (وسوف نقوم بضم الموضوعين لاحقا ) الثاني انك وجهت سؤالك لأشخاص محددين ، مع ان المنتدى مليء بعشرات الخبراء فالذين وجهت لهم النداء يعلمون ان هذه مخالفة فلا ينشطون للرد ، والذين لم تذكرهم من الطبيعي ان لا يتفاعوا معك ‘ والمثل العربي القديم يقول : على نفسها جنت براقش لهذا يجب العلم ان قوانين المشاركة حين وضعت روعي فيها مصالح كثيرة ومن ضمنها مصلحة السائل . اما بالنسبة لحاجتك فأنت بارك الله فيك خبرتك قليلة في انشاء المشاريع ففي البداية يجب تحليل بيانات المشروع ( المدخلات / المخرجات ) ثم استخدام الورق لرسم خطوات المشروع ثم الشروع في التصميم بدأَ من الجداول اللازمة والواجهات التي ستستخدمها لادخال وعرض البيانات . ( يجب ان تستخدم ادخال البيانات يدويا مهما اخذت من الجهد والوقت ) وبعد ان يكتمل برنامجك لك ان تبحث عن الاكواد التي تختصر عليك الجهد والوقت مثل الكود الخاص بالتوزيع .، وغيره من الاخطاء الموجودة عندك والتي اراك حريصا على تحقيقها هي ترحيل من يصرف له الى جدول آخر ايضا قرأت لك طلبا وهو بعد ان يتم التوزيع اذا كان احد الموظفين غائبا يعاد المبلغ الى البرنامج ويصرف له من الغد .. وهذا خطأ ايضا برنامجك بسيط وسلس وحقيقة لا يجب ان يأخذ منك كل هذا الوقت .. ولكن يوجد مشكلة مالية ( وأكرر : مالية ) ..وهي المبلغ المتبقي من التوزيع وأرى ان يتم معالجته يدويا في مكان معين لضمان ضبط العملية المالية . ختاما اخوي ابو نزار ما كتبته هو للفائدة العامة .. لك ولمن يمر من هنا اعانك الله ووفقك ،،،

السلام عليكم ورحمة الله وبركاته 💐 الحمد لله الذي بنعمته تتم الصالحات الشكر للجميع كل في مساهمته تقبل تحياتي العطرة لشخصكم الكريم والسلام عليكم ورحمة الله وبركاته 🏵️

لا اعتقد انها مفيدة في هذا المثال .. والافضل منها دالة switch

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

السلام عليكم اويد كلام اساتذتي عن الحقل المحسوب لكن اذا لزم الامر وكانت لديك قائمة منسدلة بالاضافة الى دالة IIF يمكنك ايضا استخدام دالة Choose في الحقل المحسوب تحياتي

تحتاج الى 22 iif وهذه الطريقة متعبة المبرمجون المحترفون لا يحبذون الرقم المحسوب ي الجدول

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

يمكنك وضعه في الجدول بتحويل الحقل eldarga2 لقائمة منسدلة فيها بيانات جدول الدرجات والأفضل وضعها في استعلام يقوم بإحضار الدرجة لك تلقائيا . أما بالطريقة الحالية لا أعرف ما الجدوى من وجود الحقل المحسوب في نفس جدول الدرجات ؟! 🙂 لعلك توضح لنا هذه النقطة ؟

على حسب ما فهمت هذا ما تحتاجه Sub PRINT_OUT() Range("a1:i29").PrintOut Copies:=2 End Sub

استخدم هذا الكود أخي عمر .. وهو بالعربي .. تضعه في موديول منفصل ثم تستدعيه كما هو موضح بالأسفل مثال : Public Function DateAsText(GivenDate As Date) As String Dim Daytxt, Monthtxt, Yeartxt As String Daytxt = NoToTxt(Day(GivenDate), "", "") 'Monthtxt = "من شهر " & NoToTxt(Month(GivenDate), "", "") ' فعل هذا السطر إذا أردت كتابة الشهر بالرقم وليس بالاسم Monthtxt = "من شهر " & MonthName(Month(GivenDate)) Yeartxt = "سنة" & NoToTxt(Year(GivenDate), "", "") DateAsText = Daytxt & "" & Monthtxt & " " & Yeartxt & "ميلادي" End Function Function NoToTxt(TheNo As Double, MyCur As String, MySubCur As String) As String Dim MyArry1(0 To 9) As String Dim MyArry2(0 To 9) As String Dim MyArry3(0 To 9) As String Dim MyNo As String Dim GetNo As String Dim RdNo As String Dim My100 As String Dim My10 As String Dim My1 As String Dim My11 As String Dim My12 As String Dim GetTxt As String Dim Mybillion As String Dim MyMillion As String Dim MyThou As String Dim MyHun As String Dim MyFraction As String Dim MyAnd As String Dim i As Integer Dim ReMark As String If TheNo > 999999999999.99 Then Exit Function If TheNo = 0 Then NoToTxt = "صفر" Exit Function End If MyAnd = " و" MyArry1(0) = "" MyArry1(1) = "مائة" MyArry1(2) = "مائتان" MyArry1(3) = "ثلاثمائة" MyArry1(4) = "أربعمائة" MyArry1(5) = "خمسمائة" MyArry1(6) = "ستمائة" MyArry1(7) = "سبعمائة" MyArry1(8) = "ثمانمائة" MyArry1(9) = "تسعمائة" MyArry2(0) = "" MyArry2(1) = " عشر" MyArry2(2) = "عشرون" MyArry2(3) = "ثلاثون" MyArry2(4) = "أربعون" MyArry2(5) = "خمسون" MyArry2(6) = "ستون" MyArry2(7) = "سبعون" MyArry2(8) = "ثمانون" MyArry2(9) = "تسعون" MyArry3(0) = "" MyArry3(1) = "واحد" MyArry3(2) = "اثنان" MyArry3(3) = "ثلاثة" MyArry3(4) = "أربعة" MyArry3(5) = "خمسة" MyArry3(6) = "ستة" MyArry3(7) = "سبعة" MyArry3(8) = "ثمانية" MyArry3(9) = "تسعة" '====================== GetNo = Format(TheNo, "000000000000.00") i = 0 Do While i < 15 If i < 12 Then MyNo = Mid$(GetNo, i + 1, 3) Else MyNo = "0" + Mid$(GetNo, i + 2, 2) End If If (Mid$(MyNo, 1, 3)) > 0 Then RdNo = Mid$(MyNo, 1, 1) My100 = MyArry1(RdNo) RdNo = Mid$(MyNo, 3, 1) My1 = MyArry3(RdNo) RdNo = Mid$(MyNo, 2, 1) My10 = MyArry2(RdNo) If Mid$(MyNo, 2, 2) = 11 Then My11 = "إحدى عشر" If Mid$(MyNo, 2, 2) = 12 Then My12 = "إثنى عشر" If Mid$(MyNo, 2, 2) = 10 Then My10 = "عشرة" If ((Mid$(MyNo, 1, 1)) > 0) And ((Mid$(MyNo, 2, 2)) > 0) Then My100 = My100 + MyAnd If ((Mid$(MyNo, 3, 1)) > 0) And ((Mid$(MyNo, 2, 1)) > 1) Then My1 = My1 + MyAnd GetTxt = My100 + My1 + My10 If ((Mid$(MyNo, 3, 1)) = 1) And ((Mid$(MyNo, 2, 1)) = 1) Then GetTxt = My100 + My11 If ((Mid$(MyNo, 1, 1)) = 0) Then GetTxt = My11 End If If ((Mid$(MyNo, 3, 1)) = 2) And ((Mid$(MyNo, 2, 1)) = 1) Then GetTxt = My100 + My12 If ((Mid$(MyNo, 1, 1)) = 0) Then GetTxt = My12 End If If (i = 0) And (GetTxt <> "") Then If ((Mid$(MyNo, 1, 3)) > 10) Then Mybillion = GetTxt + " مليار" Else Mybillion = GetTxt + " مليارات" If ((Mid$(MyNo, 1, 3)) = 2) Then Mybillion = " مليار" If ((Mid$(MyNo, 1, 3)) = 2) Then Mybillion = " ملياران" End If End If If (i = 3) And (GetTxt <> "") Then If ((Mid$(MyNo, 1, 3)) > 10) Then MyMillion = GetTxt + " مليون" Else MyMillion = GetTxt + " ملايين" If ((Mid$(MyNo, 1, 3)) = 1) Then MyMillion = " مليون" If ((Mid$(MyNo, 1, 3)) = 2) Then MyMillion = " مليونان" End If End If If (i = 6) And (GetTxt <> "") Then If ((Mid$(MyNo, 1, 3)) > 10) Then MyThou = GetTxt + " ألف" Else MyThou = GetTxt + " آلاف" If ((Mid$(MyNo, 3, 1)) = 1) Then MyThou = " ألف" If ((Mid$(MyNo, 3, 1)) = 2) Then MyThou = " ألفان" End If End If If (i = 9) And (GetTxt <> "") Then MyHun = GetTxt If (i = 12) And (GetTxt <> "") Then MyFraction = GetTxt End If i = i + 3 Loop If (Mybillion <> "") Then If (MyMillion <> "") Or (MyThou <> "") Or (MyHun <> "") Then Mybillion = Mybillion + MyAnd End If If (MyMillion <> "") Then If (MyThou <> "") Or (MyHun <> "") Then MyMillion = MyMillion + MyAnd End If If (MyThou <> "") Then If (MyHun <> "") Then MyThou = MyThou + MyAnd End If If MyFraction <> "" Then If (Mybillion <> "") Or (MyMillion <> "") Or (MyThou <> "") Or (MyHun <> "") Then NoToTxt = ReMark + Mybillion + MyMillion + MyThou + MyHun + " " + MyCur + MyAnd + MyFraction + " " + MySubCur Else NoToTxt = ReMark + MyFraction + " " + MySubCur End If Else NoToTxt = ReMark + Mybillion + MyMillion + MyThou + MyHun + " " + MyCur End If End Function وطريقة استدعائه (كمصدر للخلية أو في الاستعلام) كالتالي : = DateAsText([Date])

وعليكم السلام ورحمة الله وبركاته أخي أحمد .. الطريقة الأنسب أخي أحمد أن يكون جدول الدرجات منفصل .. ثم تضع بياناته في قائمة منسدلة .. ثم بعد ذلك في النموذج الخاص بتسجيل الدرجات تضع كود تسجيل الدرجة في الحقل الرقمي المرغوب ( لن تحتاج للحقل المحسوب ) .. هذا المثال : وهذا الكود ( عند تحديث القائمة المنسدلة ) : Private Sub DrjhCbo_AfterUpdate() Me.eldarga2 = Me.DrjhCbo.Column(1) End Sub المرفق : الدرجه (1).accdb

@mra63 لا ادري لماذا اصرارك على عدم ادراج ملف وانشاء يوزرفورم حتى يستطيع الاخرين مساعدتك . عالعموم انشأ يوزفورم به اثنان تيكست بوكس وقم بالنقر مرتين على اليوزفورم والصق هذه الاكواد كاملة . عند تشغيل اليوزرفورم سيتم تلوين textbox1,2 باللون الاصفر و اذا كتبت في احدهم سيتلون بالابيض . Private Sub TextBox1_Change() If TextBox1.Text <> "" Then TextBox1.BackColor = RGB(255, 255, 255) Else TextBox1.BackColor = RGB(255, 255, 0) End If End Sub Private Sub TextBox2_Change() If TextBox2.Text <> "" Then TextBox2.BackColor = RGB(255, 255, 255) Else TextBox2.BackColor = RGB(255, 255, 0) End If End Sub Private Sub UserForm_Initialize() TextBox1.BackColor = RGB(255, 255, 0) TextBox2.BackColor = RGB(255, 255, 0) End Sub

وعليكم السلام ورحمة الله وبركاته يوجد دالة الفرنسية أنت غير فيها Function ConversionHeures(Nombre As Integer) As String If Nombre = 0 Or Nombre = 24 Then ConversionHeures = "Minuit " Exit Function ElseIf Nombre = 12 Then ConversionHeures = "Midi " Exit Function End If Const stEspace As String = " " Dim Varnum, VarnumD, VarnumU, Resultat, Varlet Static Chiffre(1 To 19) Chiffre(1) = "une" Chiffre(2) = "deux" Chiffre(3) = "trois" Chiffre(4) = "quatre" Chiffre(5) = "cinq" Chiffre(6) = "six" Chiffre(7) = "sept" Chiffre(8) = "huit" Chiffre(9) = "neuf" Chiffre(10) = "dix" Chiffre(11) = "onze" Chiffre(12) = "douze" Chiffre(13) = "treize" Chiffre(14) = "quatorze" Chiffre(15) = "quinze" Chiffre(16) = "seize" Chiffre(17) = "dix-sept" Chiffre(18) = "dix-huit" Chiffre(19) = "dix-neuf" Static dizaine(1 To 9, 1 To 5) dizaine(1, 1) = "dix" dizaine(2, 1) = "vingt" dizaine(3, 1) = "trente" dizaine(4, 1) = "quarante" dizaine(5, 1) = "cinquante" dizaine(6, 1) = "soixante" dizaine(7, 1) = "soixante" dizaine(8, 1) = "quatre-vingt" dizaine(9, 1) = "quatre-vingt" Resultat = "" Varnum = Int(Nombre) Mod 1000 If Varnum > 0 Then GoSub centaine_dizaine Resultat = Resultat + " " + Varlet End If Resultat = LTrim(Resultat) Varlet = Right$(Resultat, 4) 'traitement du "s" final pour vingt et cent Select Case Varlet Case "cent", "ingt" Resultat = Resultat + "s" End Select FinTraitement: Resultat = Resultat + stEspace 'renvoi du résultat de la fonction et fin de la fonction ConversionHeures = Replace(Resultat, " ", " ") Exit Function 'sous programme centaine_dizaine: Varlet = "" 'traitement des centaines If Varnum >= 100 Then Varlet = Chiffre(Int(Varnum / 100)) Varnum = Varnum Mod 100 If Varlet = "un" Then Varlet = "cent " Else Varlet = Varlet + " cent " End If End If 'traitement des dizaines If Varnum <= 19 Then If Varnum > 0 Then: Varlet = Varlet + Chiffre(Varnum) Else VarnumD = Int(Varnum / 10) VarnumU = Varnum Mod 10 Varlet = Varlet + dizaine(VarnumD, 1) If VarnumU = 1 And VarnumD < 8 Then Varlet = Varlet + " et " Else If VarnumU <> 0 Or VarnumD = 7 Or VarnumD = 9 Then: Varlet = Varlet & " " End If If VarnumD = 7 Or VarnumD = 9 Then: VarnumU = VarnumU + 10 If VarnumU <> 0 Then: Varlet = Varlet + Chiffre(VarnumU) End If Varlet = Trim(Varlet) Return End Function للعم الشهر يأخذه من نظام الكمبيوتر

السلام عليكم جرّب أخي الكريم وأخبرني النتيجة تم التعديل على لون التيكست فورم.xlsm

السلام عليكم أخي الكريم أخي الكريم ضع شرطاً للتكست بوكس إن كان فارغاً لونه بالأصفر وإلا باللون الأبيض Private Sub TextBox1_Change() If TextBox1.Value = "" Then TextBox1.BackColor = vbYellow Else TextBox1.BackColor = vbWhite End If End Sub كما هو معروض في الصورة التالية: تقبل تحياتي والسلام عليكم

تأكد أن تكون نتيجة المعادلة أي صفر أو فراغ عندها أكيد لن يكون الفرز صحيحاً. أخي ممكن تعمل نسخة مصغرة عنه وترسله؟

السلام عليكم ورحمة الله تفضل sample.xlsx

تفضل هذا التعديل Microsoft Access3.zip