Foksh

الشكر لله وحده من قبل ومن بعد على ما علمنا العفو يا مهندسنا الغالي ، ما هي إلا إبداعاتكم وتوجيهاتكم وتنسيقاتكم وأفكاركم ولا انت خايف يطلع حد خسران ويحكي ان اللعبة خسرته ويجي عندك يقولك مصعبها علينا 😂 جزاكم الله خيراً على ابداعاتكم ، وفعلاً لعبة مسلية وتساعد على التركيز ، ولكن 😤 !!!!! أحياناً يا أخي ما ألحق الوقت وأخسر 😭

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

ما شاء الله ، تبارك الله .. أفكار وحلول جميلة ، من الأساتذة ( @hegazee ، @محمد هشام. ... ) ، ولهذا وددت أيضاً تطوير الفكرة بحيث عند وجود أكثر من فارق بين ( قبل وبعد ) في نفس الصف ، ان يتم تمييز كل فارق بلون مختلف لتسهل معرفة وتتبع الفروقات عند السجلات الكبيرة . حيث تم تعديل الدالة الرئيسية فقط كالآتي :- Public Sub HighlightGradeDifferencesGeneral(ByVal sheetObject As Worksheet, _ ByVal rangeBeforeAddress As String, _ ByVal rangeAfterAddress As String, _ Optional ByVal showMessage As Boolean = True) Dim rangeBefore As Range Dim rangeAfter As Range Dim cellAfter As Range Dim cellBefore As Range Dim i As Long Dim j As Long Dim colorPalette As Variant Dim colorIndex As Long colorPalette = Array(6, 3, 4, 7, 8, 9, 10, 12) On Error GoTo ErrorHandler Set rangeBefore = sheetObject.Range(rangeBeforeAddress) Set rangeAfter = sheetObject.Range(rangeAfterAddress) If rangeBefore.Rows.Count <> rangeAfter.Rows.Count Or _ rangeBefore.Columns.Count <> rangeAfter.Columns.Count Then If showMessage Then MsgBox "نطاق 'قبل' (" & rangeBeforeAddress & ") ونطاق 'بعد' (" & rangeAfterAddress & ") " & _ "في الورقة '" & sheetObject.Name & "' ليسا بنفس الأبعاد . يرجى التحقق", vbExclamation + vbMsgBoxRight, "" End If Exit Sub End If Application.EnableEvents = False Application.ScreenUpdating = False rangeBefore.Interior.colorIndex = xlNone rangeAfter.Interior.colorIndex = xlNone For i = 1 To rangeAfter.Rows.Count colorIndex = 0 For j = 1 To rangeAfter.Columns.Count Set cellAfter = rangeAfter.Cells(i, j) Set cellBefore = rangeBefore.Cells(i, j) If Not IsEmpty(cellAfter.Value) And Not IsEmpty(cellBefore.Value) Then If cellAfter.Value <> cellBefore.Value Then cellAfter.Interior.colorIndex = colorPalette(colorIndex) cellBefore.Interior.colorIndex = colorPalette(colorIndex) colorIndex = (colorIndex + 1) Mod (UBound(colorPalette) + 1) End If ElseIf (IsEmpty(cellAfter.Value) And Not IsEmpty(cellBefore.Value)) Or _ (Not IsEmpty(cellAfter.Value) And IsEmpty(cellBefore.Value)) Then cellAfter.Interior.colorIndex = colorPalette(colorIndex) cellBefore.Interior.colorIndex = colorPalette(colorIndex) colorIndex = (colorIndex + 1) Mod (UBound(colorPalette) + 1) End If Next j Next i If showMessage Then MsgBox "اكتملت المقارنة وتم تلوين الاختلافات في الورقة '" & sheetObject.Name & "'.", vbInformation + vbMsgBoxRight, "" End If ErrorHandler: Application.ScreenUpdating = True Application.EnableEvents = True If Err.Number <> 0 And showMessage Then MsgBox "حدث خطأ في الورقة '" & sheetObject.Name & "': " & Err.Description, vbCritical + vbMsgBoxRight, "" End If End Sub الملف بعد إضافة التعديل درجات المواد.xlsm وصورة توضيحية للنتيجة

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

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

وعليكم السلام ورحمة الله وبركاته ,, يوجد طريقة بالتنسيق الشرطي قد تكون فكرة أحد الأساتذة ، ولكني اتجهت الى سلوك آخر من خلال VBA مع إضافة المرونة في الإستخدام لأكثر من ورقة ، وكل ورقة بنطاقات مختلفة .. في مديول جديد يتم اضافة الكود التالي :- Public Sub HighlightGradeDifferencesGeneral(ByVal sheetObject As Worksheet, _ ByVal rangeBeforeAddress As String, _ ByVal rangeAfterAddress As String, _ Optional ByVal showMessage As Boolean = True) Dim rangeBefore As Range Dim rangeAfter As Range Dim cellAfter As Range Dim cellBefore As Range Dim i As Long Dim j As Long Dim highlightColor As Long On Error GoTo ErrorHandler Set rangeBefore = sheetObject.Range(rangeBeforeAddress) Set rangeAfter = sheetObject.Range(rangeAfterAddress) highlightColor = 6 If rangeBefore.Rows.Count <> rangeAfter.Rows.Count Or _ rangeBefore.Columns.Count <> rangeAfter.Columns.Count Then If showMessage Then MsgBox "نطاق 'قبل' (" & rangeBeforeAddress & ") ونطاق 'بعد' (" & rangeAfterAddress & ") " & _ "في الورقة '" & sheetObject.Name & "' ليسا بنفس الأبعاد . يرجى التحقق", vbExclamation + vbMsgBoxRight, "" End If Exit Sub End If Application.EnableEvents = False rangeBefore.Interior.ColorIndex = xlNone rangeAfter.Interior.ColorIndex = xlNone For i = 1 To rangeAfter.Rows.Count For j = 1 To rangeAfter.Columns.Count Set cellAfter = rangeAfter.Cells(i, j) Set cellBefore = rangeBefore.Cells(i, j) If Not IsEmpty(cellAfter.Value) And Not IsEmpty(cellBefore.Value) Then If cellAfter.Value <> cellBefore.Value Then cellAfter.Interior.ColorIndex = highlightColor cellBefore.Interior.ColorIndex = highlightColor End If ElseIf (IsEmpty(cellAfter.Value) And Not IsEmpty(cellBefore.Value)) Or _ (NotEmpty(cellAfter.Value) And IsEmpty(cellBefore.Value)) Then cellAfter.Interior.ColorIndex = highlightColor cellBefore.Interior.ColorIndex = highlightColor End If Next j Next i If showMessage Then MsgBox "اكتملت المقارنة وتم تلوين الاختلافات في الورقة '" & sheetObject.Name & "'.", vbInformation + vbMsgBoxRight, "" End If ErrorHandler: Application.EnableEvents = True If Err.Number <> 0 And showMessage Then MsgBox "حدث خطأ في الورقة '" & sheetObject.Name & "': " & Err.Description, vbCritical + vbMsgBoxRight, "" End If End Sub Function NotEmpty(cellValue As Variant) As Boolean NotEmpty = Not IsEmpty(cellValue) End Function وفي حدث Worksheet_Change للورقة التي تريدها ، نستخدم الاستدعاء بالشكل التالي :- Private Sub Worksheet_Change(ByVal Target As Range) Dim watchRangeBefore_Sheet1 As Range Dim watchRangeAfter_Sheet1 As Range Dim ws As Worksheet Set ws = Me ' --- حدد النطاقات الخاصة بـ Sheet1 --- Dim beforeAddress_Sheet1 As String Dim afterAddress_Sheet1 As String beforeAddress_Sheet1 = "B3:I14" ' نطاق "قبل" في Sheet1 afterAddress_Sheet1 = "K3:R14" ' نطاق "بعد" في Sheet1 On Error GoTo SafeExit Set watchRangeBefore_Sheet1 = ws.Range(beforeAddress_Sheet1) Set watchRangeAfter_Sheet1 = ws.Range(afterAddress_Sheet1) If Not Intersect(Target, watchRangeBefore_Sheet1) Is Nothing Or _ Not Intersect(Target, watchRangeAfter_Sheet1) Is Nothing Then Call HighlightGradeDifferencesGeneral(sheetObject:=ws, _ rangeBeforeAddress:=beforeAddress_Sheet1, _ rangeAfterAddress:=afterAddress_Sheet1, _ showMessage:=False) End If SafeExit: If Err.Number <> 0 Then End If End Sub لاحظ أنه في كود الاستدعاء داخل الورقة التي تريد التطبيق عليها ، تستطيع تحديد النطاق من - إلى كيفما تشاء ، وطبعاً مع ضرورة تغيير اسم الورقة بدلاً من Sheet1 إلى اسم الورقة الثانية في حال اري الاستدعاء في أكثر من ورقة . هذا سيضمن لك الإستدعاء مع التحديد النطاق ( قبل و بعد ) لكل ورقة ولكن بدالة واحدة مرنة . الملف بعد التطبيق :- درجات المواد.xlsm

شو يعني ، ما فهمت أخي الكريم 😅

وعليكم السلام ورحمة الله وبركاته ،، أهلا بعودتكم أستاذنا الفاضل @منتصر الانسي ، وبعد عودتكم بفكرة جميلة جداً .. فسلمت على هذه الفكرة الجميلة اهتمامك حتى بفكرة الترقيم لللفاتورة جاءت بطريقة ذكية

وعليكم السلام ورحمة الله وبركاته .. حاولت أن أفهم وأن أتبين الغرض والهدف من طلبك ، ولكني لم أنجح ولم أفلح في تخيل الهدف من هذه الحركة عند فتح التقرير . على العموم .. لجعل التركيز على الكومبوبوكس اللي في النموذج List ( وأعتقد أنه من الأسماء المحجوزة لآكسيس ) ، يجب أن نجعل خاصية Modal = Yes للنموذج ، وحيث أننا لا نريد تغيير الخصائص للنموذج بشكل دائم ، فهنا يمكننا استخدام الدالة WindowMode طبعاً مع تحديد نوع أو نمط فتح النموذج بحيث تكون = WindowMode:=acWindowNormal . وعليه فأن الكود النهائي في حدث عند التحميل للتقرير سيكون كالآتي :- Private Sub Report_Load() DoCmd.OpenForm "List", WindowMode:=acWindowNormal Forms("List").Modal = True Forms("List").Combo0.SetFocus End Sub جربه في تقريرك ، وأخبرنا بالنتيجة .

الإجابة من طرفي ستكون نفس الإجابة في الموضوع التالي :-

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

وبارك الله بكم أخي الكريم ،، هو متاح للجميع دون استئذان ، وصدقة جارية عن روح والدي رحمه الله ,, فدعائكم له بالرحمة أكبر مكافأة .

وعليكم السلااام ورحمة الله وبركاته .. يا هلا بالأفكار انيرة ، والإبداعات المثيرة . تحفة فنية جمية منسوجة بإحكاااااام وبراعة عند قراءة الفكرة وبتمعن ، خطر لي سؤال :- ماذا يحدث عند نقل قاعدة البيانات إلى جهاز جديد ؟ ( هل سيتم نقل بيانات الاعتماد تلقائياً ؟ ) لكن جوهر الفكرة جميل جداً بأفكار صاحب الأفكار الجميلة ,,,

بسيطة ان شاء الله اخي الكريم ، جرب هذا التعديل ، حيث تم استخدام الكود التالي للتحقق والاضافة عندم عدم وجود العام الدراسي الحالي . Private Sub MeetingDate_AfterUpdate() Dim academicYear As String Dim rs As DAO.Recordset Dim response As VbMsgBoxResult Dim prevDate As Variant On Error GoTo ErrHandler academicYear = IIf(Month(Me.MeetingDate) >= 9, _ Year(Me.MeetingDate) & "-" & (Year(Me.MeetingDate) + 1), _ (Year(Me.MeetingDate) - 1) & "-" & Year(Me.MeetingDate)) Set rs = CurrentDb.OpenRecordset("SELECT Academic_Name FROM AcademicYearTble WHERE Academic_Name = '" & academicYear & "'", dbOpenSnapshot) If rs.EOF Then response = MsgBox("العام الدراسي """ & academicYear & """ غير موجود." & vbCrLf & "هل تريد إضافته؟", vbQuestion + vbYesNo + vbMsgBoxRight, "إضافة عام دراسي") If response = vbYes Then CurrentDb.Execute "INSERT INTO AcademicYearTble (Academic_Name) VALUES ('" & academicYear & "')", dbFailOnError Me.Academic_Name = academicYear Else MsgBox "تم إلغاء التحديث.", vbExclamation Me.Undo End If Else Me.Academic_Name = academicYear End If rs.Close Set rs = Nothing Exit Sub ErrHandler: MsgBox "حدث خطأ: " & Err.Description, vbCritical + vbMsgBoxRight, "" On Error Resume Next rs.Close Set rs = Nothing End Sub الملف بعد التعديل AcademicYear2.accdb

لا تعلو عين فوق حاجبها .. أنتم الأصل ومنكم نستفيد ونتعلم معلمي الفاضل . بالطبع هو أفضل ، وإن كان لي رأي في التصميم نفسه !! فما الحاجة لأن يكون مكرراً قيمة السنة في مربعي نص ( كود السنة الاكاديمية ، و اختيار السنة الاكاديمية ) . ولكني تماشيت مع طلبه ليس إلا .

في كانت كفكرة تشبيه إنه يكون عنده أكثر من فاتورة = أكثر من طاولة . ومن الغير طبيعي انه يكون الكاشير قادر على التعامل مع أكثر من 3 فواتير تقريباً .. فهنا ممكن يكون عنده زر "فواتير مستخدمة الآن" على سبيل المثال . ويقدر يحجز فاتورة بسجل جديد الفكرة كانت تشبيه فقط ، كأن المستخدم عنده أكثر من فاتورة شغالة في نفس الوقت ، زي نظام الطاولات في مطعم ، كل طاولة لها فاتورة خاصة ، ويتنقل بينها بحرية . وطبيعي إن الكاشير ما يقدر يتابع أكثر من 2 أو 3 فواتير بنفس الوقت ، فممكن يكون فيه زر مثلاً اسمه "فواتير قيد الاستخدام" ، يعرض له الفواتير المفتوحة اللي ما تم إنهاؤها . يقدر من خلاله يحجز فاتورة جديدة (زي حجز طاولة) ، ويتنقل بين الفواتير النشطة ، وينهيها وقت الدفع . وطبعاً هنا نقدر نسمي الفكرة بـ "تعليقا فاتورة" بحيث عند النقر عليه يتم تعليقا الفاتورة والإستفادة من فكرة الحقل Yes/No السابق ذكره ,

بالطبع سيكون الموضوع أكبر من مجرد قيمة = قيمة ، فماذا لو كان الاختيار لتاريخ أكبر بـ 5 سنوات وغير مدرج في الكومبوبوكس Academic_Name !!!!

وعليكم السلام ورحمة الله وبركاته ،، مشاركة معنوية مع الأساتذة والمعلمين ، وكفكرة أستاذنا @kkhalifa1960 ، هي جميلة وتجهلك تتنقل بين الفواتير التي تريدها ، وتستطيع التعديل عليها كتحسين ( لا ينقص من جمالها شيء طبعاً ) بحيث يتم تعليم الفواتير التي تم دفعها بحقل Yes/No = Yes للفواتير المدفوعة ، وهنا سيتم عرض الفواتير التي لها قيمة = No . وطبعاً في زر الدفع سيتم اضافة استعلام لتحديث قيمة هذا الحقل = Yes مع Requery للقائمة المنسدلة . أو أن التنفيذ الذي يحاول أخونا الكريم الوصول اليه هو ما يشبه نظام الطاولات في مطعم على سبيل المثال ، على اعتبار ان الطاولات هي فواتير مفتوحة ولكل فاتورة رقم تم حجزه ويحتوي بيانات ، ويتنقل بينها كيف ما يشاء وإنهاء ما يشاء حسب الإنتهاء منهم .

وعليكم السلام ورحمة الله وبركاته ,, جرب هذه الفكرة البسيطة ، في حدث بعد التحديث لمربع نص تاريخ الإجتماع :- Private Sub MeetingDate_AfterUpdate() Me.Academic_Name = Me.Text7 End Sub طبعاً هذا سيعتمد على تحديث القيم في القائمة المنسدلة بشكل تلقائي كل سنة دراسية على سبيل المثال , AcademicYear.accdb

الله يعطيكم العافية ، نقاشكم أثرى معلوماتي وأضاف لي الكثير ، فجزاكم الله خيراً . تسمحولي أطرح عليكم كم سؤال خطروا في بالي .. ؟ 🔸 في التطبيقات الكبيرة التي تحتوي على بيانات ضخمة ، برأيكم : هل من الأنسب تحميل البيانات من جدول الإعدادات إلى TempVars عند بدء التشغيل ، أم أن القراءة من الجدول عند الطلب أفضل ؟ ولماذا ؟ 🤔 🔸 هل ترون أن وجود جدول إعدادات واحد رئيسي كافٍ ؟ ، أم أن الأفضل تقسيم الإعدادات على جداول منفصلة حسب الحاجة (مثل إعدادات النظام ، المستخدم ، النماذج ... إلخ ) ؟ 🔸 وأخيراً ، إذا تغيّرت بعض الإعدادات أثناء تشغيل البرنامج ، فما الطريقة المثلى لإعادة تحميل أو تحديث TempVars دون الحاجة لإعادة تشغيل البرنامج ؟ 🌟 كل الشكر والتقدير لكم معلمينا وأساتذتنا الأفاضل .

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

تعقيباً على ما أشار إليه المهندس @Moosak ، ومن باب التوضيح ، فإن الترتيب المثالي ( من الناحية الفنية والأداء ) يجب أن يكون :- الثوابت ( Constants ) يجب أن تظهر بعد الإعلانات لأنها قد تعتمد على قيم من الإعلانات . الإعلانات ( Declares ) يجب أن تكون في البداية لأن الكود البرمجي يعتمد عليها . وضع الكود البرمجي في النهاية يجعل الكود أكثر تنظيماً وسهولة في القراءة . فشكراً للفت الإنتباه لهذه النقطة ، وقد تم الانتهاء منها بإذن الله تعالى .

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

وعليكم السلام ورحمة الله وبركاته ،، أتمنى أن تكون الصورة قد وضحت لي وتم فهمها بالشكل الصحيح 😅 .. انظر للصورة الأولى :- والنتيجة للصورة الثانية :- هل تلبي المطلوب بالشكل الصحيح ؟ خبرتي في اكسل قليلة جداً مقارنة مع الأساتذة ( دون استثناء ) في هذا الصرح الكبير . التنفيذ تم باستخدام الماكرو التالي :- Sub FillAccountNum() Dim ws As Worksheet Dim lastRow As Long Dim i As Long, j As Long Dim accountVal As String Set ws = ActiveSheet lastRow = ws.Cells(ws.Rows.Count, "K").End(xlUp).Row For i = 2 To lastRow If InStr(1, ws.Cells(i, "K").Value, "متبقي تعاقد مشروع قسط") > 0 Then For j = i + 1 To lastRow If Trim(ws.Cells(j, "A").Value) Like "Account*" Then accountVal = ws.Cells(j, "A").Value ws.Cells(i, "A").Value = accountVal Exit For End If Next j End If Next i End Sub المرفق بعد التنفيذ :- EXPORT.xlsm وفيما يلي ، توضيح لتفعيل وضع المطور واختيار الماكرو للشيت الحالي .. جرب وأخبرني بالنتيجة ، للمتابعة .

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