كل الانشطه

إطلالة سريعة على هذا الموضوع قد تكون مفيده بدرجة كبيرة قد لا تتصورها : جدول بآيات القرآن الكريم كاملا.zip

رب ارزقني وعجل لماذا حذفت عمود عدد الآيات؟ ارفق تعديلك بارك الله فيك

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

سيتم التجربة و تصميم الكود والمحاولة حسب الطريقة التي ذكرتها لي

الصحيح ان يكون جدول السور عبارة عن 114 سجلا فقط ( كل اسم سورة في سجل وحيد) ونضيف الى جدول الآيات حقلا معرفا لرقم السورة ثم نربط العلاقة بين الجدولين رأس لأطراف بمعرفة رقم السورة في الجدولين سبق وان عملت على قاعدة مثل هذه وما زالت الأساسات عندي للعلم يمكنك البحث بالايات وايضا الذهاب الى اول الجزء او او السورة او الى صفحة محددة

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

استخدم هذه الشيفرى Private Sub Command30_Click() Dim rs As DAO.Recordset With Forms("القرآن الكريم") Set rs = .RecordsetClone rs.FindFirst "SurahNo = 1" ' عدّل القيمة حسب ما تريد البحث عنه If Not rs.NoMatch Then .Bookmark = rs.Bookmark Else MsgBox "لم يتم العثور على السورة المطلوبة.", vbExclamation End If End With End Sub Private Sub Command33_Click() Dim rs As DAO.Recordset With Forms("القرآن الكريم") Set rs = .RecordsetClone rs.FindFirst "SurahNo = " & Me![SurahNo] + 1 If Not rs.NoMatch Then .Bookmark = rs.Bookmark Else MsgBox "لم يتم العثور على السورة السابقة.", vbExclamation End If End With End Sub Private Sub Command34_Click() Dim rs As DAO.Recordset With Forms("القرآن الكريم") Set rs = .RecordsetClone rs.FindFirst "SurahNo = " & Me![SurahNo] - 1 If Not rs.NoMatch Then .Bookmark = rs.Bookmark Else MsgBox "لم يتم العثور على السورة السابقة.", vbExclamation End If End With End Sub Private Sub Command35_Click() Dim rs As DAO.Recordset With Forms("القرآن الكريم") Set rs = .RecordsetClone rs.FindFirst "SurahNo = 114" ' عدّل القيمة حسب ما تريد البحث عنه If Not rs.NoMatch Then .Bookmark = rs.Bookmark Else MsgBox "لم يتم العثور على السورة المطلوبة.", vbExclamation End If End With End Sub طبعا التعديل على المثال الاول الذي اوردته انت

أنت اللي حاط الوقت .. تصرف !! 😂😅

هذه محاولة ثانية بارك الله بك وبجهدك حبيبي طالما يكون فيه المصلحة لتنفيذ المطلوب لا مانع من ذلك

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

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

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

ايضا من الافكار اذا رغبنا في عدم تغيير طريقة الاخ حسين وحيث يشير الى عدم الرغبة في استخدام الماوس والكتابة مباشرة هنا يمكن برمجة احد مفاتيح الكيبورد لنقل الركيز للنموذج If KeyCode = vbKeyF4 Then Forms!list.SetFocus End If مع ان الحل المقدم منكم افضل تحياتي

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

اعرض الملف 📅📚🔥>> لعبة مطابقة الأرقام 2 :: لتنمية مهارة التركيز 😉👌 <<🧮🌟 :: الإصدار الثاني المطور 😎✌ :: السلام عليكم ورحمة الله وبركاته 🙂 🖐🌷 :: عدنا إليكم بالإصدار المطور من اللعبة الجميلة 😊🎁 🧮📚>> لعبة مطابقة الأرقام 2.0 <<📚🧮 ملخص اللعبة هو : اللعبة تعطيك رقم عشوائي وكل ما عليك فعله هو إعادة كتابة الرقم من خلال لوحة الأزار التي أمامك أو من خلال أزرار الكيبورد في زمن محدد 😊🖐 .... أنتظر .. هذا ليس كل شيء .. !! 😉 ستخوض تحدي حقيقي هذه المرة خلال عبورك عشر مستويات من الإثارة والمتعة .. حيث أن في كل مستوى سوف يتم إعادة توزيع الأرقام في الأزرار بشكل عشوائي وكذلك عدد الأرقام يزداد والزمن المحدد يقل مما يزيد الإثارة في كل مستوى .. 😁👌 :: مميزات اللعبة والتحديثات الجديدة :: * يمكن اللعب بشكل فردي أو بشكل جماعي (أكثر من لاعب) * * مرحلة تدريبية قبل الشروع في المستوى الأول * * يمكن التنقل بين المستويات العشرة * * تصميم جميل وأنيق ولعبة شيقة تعينك على تمرين مهارة التركيز لديك * وهذه لقطات مختلفة من اللعبة : ::🌷 شكر وتقدير 🌷:: للأخالعزيز المهندس فادي @Foksh لتطويره اللعبة بالشكل الحالي وإضافة أفكاره النيرة ولمساته الرائعة 😊🌹 :: وختاما .. لا تنسونا من صالح دعواتكم 😊🤲:: صاحب الملف Moosak تمت الاضافه 06/04/25 الاقسام قسم الأكسيس  

ما شاء الله ، تبارك الله .. أفكار وحلول جميلة ، من الأساتذة ( @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 وصورة توضيحية للنتيجة

تحياتي للأساتذه @Foksh و @محمد هشام. على الحلول الرائعة. و إثراء للموضوع و استكمالا لما قدمه الأساتذة أقدم إضافة بسيطة لترحيل الاختلافات درجات المواد v4.xlsb

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

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

تفضل حبيبي قاعدة البيانات ‏‏القرآن الكريم 2.rar

ماذا تقصد انه يمكن الوصول للنتيجة بدونها الغرض من تطبيق هذه الطريقة هو فتح التقرير عن طريق نموذج list وليس العكس كما كان الوضع الاصلي

وعليكم السلام ورحمة الله تعالى وبركاته بطريقة أخرى أحب التنويه فقط أن كود الأستاذ @Foksh أكثر ديناميكية ومرونة لأنه يعتمد على دالة عامة تستقبل نطاقات متعددة مما يسمح باستخدامه لأي نطاق وفي أي ورقة دون الحاجة إلى تعديل داخلي في الكود بينما الكود الحالي مخصص لنطاق محدد وثابت داخل ورقة العمل وتم تقييده حسب البيانات الموجودة لديك في الملف هذا يجعل الكود أبسط وأسرع في التنفيذ لكنه أقل مرونة من حيث التعديل أو الاستخدام مع نطاقات مختلفة أو أوراق أخرى مستقبلا Option Explicit Private Sub Worksheet_Change(ByVal Target As Range) Dim i As Long, j As Long, Tbl1 As Range, Tbl2 As Range Dim a As Range, b As Range, tmp As Range Dim xColor As Long: xColor = RGB(255, 204, 0) Dim ColArr As Long: ColArr = 8 Dim départ As Long: départ = 12 Dim début As Long: début = 3 On Error GoTo CleanExit Set Tbl1 = Range("B" & début).Resize(départ, ColArr) Set Tbl2 = Range("K" & début).Resize(départ, ColArr) If Intersect(Target, Union(Tbl1, Tbl2)) Is Nothing Then Exit Sub Application.EnableEvents = False Application.ScreenUpdating = False For Each tmp In Intersect(Target, Union(Tbl1, Tbl2)) i = tmp.Row - début + 1 If i >= 1 And i <= départ Then For j = 1 To ColArr Set a = Tbl1.Cells(i, j) Set b = Tbl2.Cells(i, j) If a.Value <> b.Value Then a.Interior.Color = xColor b.Interior.Color = xColor Else a.Interior.ColorIndex = xlNone b.Interior.ColorIndex = xlNone End If Next j End If Next tmp CleanExit: Application.EnableEvents = True Application.ScreenUpdating = True End Sub درجات المواد v3.xlsb

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

في حلكم استخدمتم OpenArgs لتمرير اسم التقرير في امر فتح نموذج ليست ومن ثم يمرر الاسم لفتح التقرير واعتقد انه يمكن الوصول للنتيجة بدونها مع اني لاحظت انه باستخدام طريقتكم بتمرير اسم التقرير فتح التقرير يكون اسرع بفارق بسيط وربما اكون واهم تحياتي Database1101.accdb