ابو جودي

ما شاء الله .. الله اكبــر العمل اذا انتهى والقاعدة قائمة بالفعل انا اعتقدت انك تريد بنائها للجمعية الخيـــرية تفرغت اليوم تماما حتى اشارككم الاجر والثواب

والدى الحبيب و استاذى الجليل و معلمى القدير و والدى الحبيب استاذ @ابوخليل اولا وأخيــــرا وقبل أى شئ جزاكم الله حيــرا انتم واساتذتنا العظما لنا خير معين حياكم الله وبياكم طيب نرجع للقاعدة هل التصور للجداول والحقول يلبى الحاجة لانشاء القاعدة ام لكم رأى أخر انا وضعت التصور هذا حسب فهمى هل نبدا البناء وفق هذا المخطط

طيب شئ مهم كمان والشئ بالشئ يذكر ذات مره قرات ولا أتذكر اين قرأت هه العبارة : ان الافضل عمل العلاقات عند الحاجة داخل الاستعلامات ولكن هذه المقولة خاطئة وللاسف كنت اعتمد عليها . لماذا هى خطأ فااااااااااادح ؟ الأفضل والأسرع هو: إنشاء العلاقات الأساسية داخل التصميم (Relationships داخل نافذة العلاقات) لماذا؟ 1. الأداء وبالأخص مع القواعد المقسمة: عند وجود علاقات معرفة مسبقا بين الجداول (حتى لو كانت على الجداول المرتبطة Linked Tables في الواجهة Front-End) فإن محرك Access يكون أسرع في تنفيذ الاستعلامات لأنه يستخدم خطة تنفيذ محسنة (Execution Plan) مبنية على هذه العلاقات 2. السلامة المرجعية (Referential Integrity): عند تعريف العلاقات داخل نافذة العلاقات يمكن تفعيل خيارات مثل: فرض التكامل المرجعي الحذف والتحديث التلقائي منع السجلات اليتيمة 3. إعادة الاستخدام والصيانة: العلاقات المعرفة في التصميم تكون مرجعية هامة للمطور مما يسهل تتبع البيانات و هي أيضا تقلل من أخطاء التصميم أما في الاستعلامات: فالعلاقات تكون مؤقتة ومحصورة داخل الاستعلام فقط مما يصعب صيانتها في مشاريع أو قواعد بيانات كبيرة --- متى تستخدم العلاقات داخل الاستعلام فقط ؟ إذا كان العمل على استعلام معقد ومخصص مؤقت ولا نريد التأثير على الهيكل العام لقاعدة البيانات عند العمل مع جداول مؤقتة أو مستوردة

وده مخطط قاعدة البيانات (Database Schema) has: "يمتلك" أو "له" (يعني علاقة بين جدولين: زي إن جدول الموظفين "يمتلك" سجلات حضور أو اجازات) uses: "يستخدم" (يعني جدول الموظفين بيستخدم نوع الجدول من جدول إعدادات العمل) via Attendance: "من خلال الحضور" (يعني العلاقة بين جدول الموظفين وجدول المعالجات بتمر من خلال جدول الحضور) PK: مفتاح أساسي FK: مفتاح خارجي tblEmployees.WorkScheduleType يرتبط بـ tblWorkSchedules.ScheduleType. tblAttendance.EmployeeID و tblLeaves.EmployeeID يرتبطو بـ tblEmployees.EmployeeID. tblAdjustments.AttendanceID يرتبط بـ tblAttendance.AttendanceID. الحالة (Status) تتحسب بشكل ديناميكي عن طريق استعلام ( يعنى لن تكون قيمة مخزنة ) tblLeaves اتضاف عشان يتتبع الاجازات والمهمات مع حالة الموافقة tblEmployees ||--o{ tblAttendance : "سجل حضوره" tblEmployees ||--o{ tblLeaves : "يأخذ اجازات" tblEmployees ||--o| tblWorkSchedules : "يستخدم جدول عمل" tblAttendance ||--o{ tblAdjustments : "عالج حضوره" tblEmployees { string EmployeeID PK "المعرف الأساسي للموظف" string EmployeeName "اسم الموظف" string WorkScheduleType FK "نوع جدول العمل المرتبط" string WeekendDays "أيام عطلة نهاية الأسبوع (مثل: جمعة - سبت)" } tblWorkSchedules { string ScheduleType PK "معرف نوع جدول العمل" time StartTime "بداية الدوام" time EndTime "نهاية الدوام" number RequiredDailyHours "عدد ساعات العمل المطلوبة يوما" } tblAttendance { number AttendanceID PK "رقم سجل الحضور" string EmployeeID FK "الموظف المرتبط بالسجل" date AttendanceDate "تاريخ الحضور" time SignInTime "وقت التوقيع دخول" time SignOutTime "وقت التوقيع خروج" } tblAdjustments { number AdjustmentID PK "رقم سجل المعالجة" number AttendanceID FK "مرتبط بالحضور" string AdjustmentType "نوع المعالجة (تأخر، مهمة، تعويض...)" number AdjustedMinutes "عدد الدقائق المعوضة" string Notes "ملاحظات اختيارية" } tblLeaves { number LeaveID PK "رقم سجل الاجازة" string EmployeeID FK "الموظف صاحب الاجازة" date LeaveDate "تاريخ الاجازة أو المهمة" string LeaveType "نوع الاجازة (اجازة - مهمة - انتداب)" boolean IsApproved "هل تم اعتماد الاجازة؟" }

السلام عليكم يا استاذى الجليل و معلمى القدير و والدى الحبيب الاستاذ @ابوخليل فعلا لو وجه للمقارنة اساسا ولكن انا على دراية تامة انا القوانين او اللوائح المنظمة لادارة شئون العاملين تختلف من منظمة لاخرى ومن مكان لمكان حسب متطلبات وطبيعة العمل ووفق رغبات المالك ولانه يخدم عمل خيـــرى اولا اسأل الله تعالى العون والسداد سأحاول جاهدا ان شاء الله بما يمن به على رب العباد من الفهم والعلم طبقا للمعطيات والمتطلبات اللى حضرتك عرضتها على هيئة نقاط دعنا نناقش الهيكل العام والبنية الاساسة كتحليل للنظام وفق ما سبق وحسب فهمى الضئيل المتواضع هذا ما خطر ببالى حاليا كحجر اساس جدول الموظفين : tblEmployees EmployeeID (مفتاح أساسي PK نص : كود/رقم العامل) EmployeeName (نص : الاسم الكامل للموظف) WorkScheduleType (نص : يربط بنوع الجدول: صباحي / مسائي / مزدوج / حكومي / خاص) WeekendDays (نص : لتخزين أيام العطلة: مثلا "الجمعة - السبت") جدول إعدادات جدول العمل : tblWorkSchedules ScheduleType (مفتاح أساسي PK نص : صباحي / مسائي / ...) StartTime (وقت/تاريخ: بداية الدوام) EndTime (وقت/تاريخ: نهاية الدوام) RequiredDailyHours (عدد : عدد ساعات العمل المطلوبة في اليوم) جدول الحضور والانصراف : tblAttendance AttendanceID (مفتاح أساسي PK رقم : رقم تلقائي) EmployeeID (مفتاح خارجي FK : نص إلى tblEmployees) AttendanceDate (وقت/تاريخ : تاريخ اليوم) SignInTime (وقت/تاريخ : وقت الدخول) SignOutTime (وقت/تاريخ : وقت الخروج) ملاحظة مهمة: لا يتم تخزين الحالة : Status بل يتم احتسابها فيما بعد من خلال استعلام دكي وديناميكي جدول المعالجات : tblAdjustments AdjustmentID (مفتاح أساسي PK رقم : رقم تلقائي) AttendanceID (مفتاح خارجي FK : رقم إلى tblAttendance) AdjustmentType (نص : مثل >>--> تأخر / خروج مبكر / مهمة مؤقتة / تعويض دقائق) AdjustedMinutes (رقم : الدقائق التي تم تعويضها أو السماح بها) Notes (نص : ملاحظات إضافية اختيارية) جدول الاجازات والمهمات : tblLeaves LeaveID (مفتاح أساسي PK رقم : رقم تلقائي) EmployeeID (مفتاح خارجي FK : نص إلى tblEmployees) LeaveDate (وقت/تاريخ : تاريخ الإجازة أو المهمة) LeaveType (نص : نوع الإجازة >>--> اجازة / مهمة / انتداب) IsApproved (منطقي : نعم / لا )

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

دوال API سوف تحتاج لمعالجة خاصة مع كلتا النواتان عند كتابة الكود ان اردت التطبيق يعمل مع اى منهما نركز شوية يا فؤش أفندى من فضلك الخلاصة سياسة مايكروسوفت الرسمية مايكروسوفت تنصح باستخدام Office 64-بت فقط إذا: تتعامل مع ملفات ضخمة جدا (ملفات Excel أو Power BI) لديك RAM أكثر من 4GB وتحتاج الاستفادة منها بالكامل أما بالنسبة لـ Access فتوصي مايكروسوفت بـ Office 32-بت إذا كنت: تستخدم قواعد بيانات قديمة أو إضافات COM تعتمد على ActiveX أو كائنات VB6 وعلشان محدش يدخل بعد كده يقول لى انت جايب الكلام ده منين : من هنا رابط سياسية مايكروسوفت فى اختيار الانوية وملخص المقال كلاتى : متى تختار Office 64‑بت: إذا كنت تتعامل مع ملفات كبيرة جدا مثل Excel تتعدى 2 GB أو تستخدم Power Pivo - Power BI أو صور وفيديوهات ضخمة في PowerPoint جهازك يحتوي على ذاكرة RAM أكبر من 4 GB وتريد الاستفادة من السعة الكاملة لذاكرة الوصول هذا النوع من الاستخدام يستفيد من قدرة 64 بت على الوصول إلى مساحة عناوين كبيرة جدا (حتى تيرابايت) متى تختار Office 32‑بت: لديك إضافات COM اذن لابد من استخدام 32 بت أو مكتبات ActiveX قديمة لا تتوفر بنسخة 64 بت تستخدم ملفات Access تم ( تشفيرها ) إنشاؤها مسبقا بصيغة mde أو accde بصيغة 32 بت تعتمد في كودك على دوال Windows API أو وحدات Declare غير متوافقة مع 64 بت إلا بعد تعديل (PtrSafe و LongPtr) في هذه الحالات يظل الإصدار 32 بت هو الخيار الأكثر موثوقية واستقرارية -------------------------------------------------- الأفضل غالبا بالنسبة للتعامل مع قواعد بيانات الاكسس وهذا رأى انا الشخصى : 64 بت الأسباب: أكثر توافقا مع الأنظمة الحديثة (ويندوز 64 بت – وهو الغالب حاليا) أداء أفضل عند التعامل مع ملفات Excel أو ملفات Access ضخمة جدا (خاصة عند استخدام استعلامات خارجية أو روابط) أفضل دعم أمني على مستوى النظام (بسبب استبعاد مكتبات 32 بت القديمة غير الآمنة) استقرار أكبر على أنظمة حديثة تستخدم Office 64 بت بشكل كامل ولكن: إذا كنت تستخدم أحد التالي: مكتبات DAO/ADO قديمة ملفات ACCDE/OCX مبنية على 32بت إضافات مثل شجرة TreeView أو Mscomctl.ocx تعليمات API بدون PtrSafe الأفضل: 32 بت لأنك ستتجنب مشاكل التوافق وإعادة كتابة أو تعديل الكود لكن كمطور قواعد بيانات أكسس : بغض النظر عن النواة أفضل ممارسة هي كتابة الكود بصيغة متوافقة مع النواتين (باستخدام If VBA7 Then- PtrSafe- LongPtr# وغيرها حسب وضع الكود) بحيث تعمل برامجك على أي بيئة دون مشاكل مستقبلية

طيب ممكن رايك استاذى الجليل ومعلمى القدير استاذ @jjafferr فى التعديلات التالية والتى تمت على الوحدة انمطية العامة لتحاشى المشكلات السابقة وكذلك قمت بدعم : DCount بناء على توجيهاتكم كود الوحدة النمطية الجديد Option Compare Database Option Explicit Private m_dictHasDataCache As Object Private mbolDebugMode As Boolean ' === تمكين أو تعطيل وضع التتبع (نافذة Immediate) Public Sub EnableDebugMode(Optional ByVal bolEnable As Boolean = True) mbolDebugMode = bolEnable End Sub ' === التحقق من وجود تقرير Private Function ReportExists(ByVal strReportName As String) As Boolean On Error Resume Next ReportExists = Not CurrentProject.AllReports(strReportName) Is Nothing On Error GoTo 0 End Function ' === الحصول على RecordSource Private Function GetRecordSource(ByVal strReportName As String) As String On Error GoTo ErrHandler DoCmd.OpenReport strReportName, acViewPreview, , , acHidden GetRecordSource = Trim(Reports(strReportName).RecordSource) DoCmd.Close acReport, strReportName Exit Function ErrHandler: GetRecordSource = "" End Function ' === تنظيف الكاشات Public Sub ClearCaches() If Not m_dictHasDataCache Is Nothing Then m_dictHasDataCache.RemoveAll End If End Sub ' === تحديد نوع بيانات حقل في جدول أو استعلام Private Function GetFieldDataType(ByVal strRecordSource As String, ByVal strFieldName As String) As Integer Dim dbs As DAO.Database Dim tdf As DAO.TableDef Dim qdf As DAO.QueryDef Dim fld As DAO.Field On Error GoTo ErrHandler Set dbs = CurrentDb On Error Resume Next Set tdf = dbs.TableDefs(strRecordSource) If Err.Number = 0 Then Set fld = tdf.Fields(strFieldName) GetFieldDataType = fld.Type Else Err.Clear Set qdf = dbs.QueryDefs(strRecordSource) If Err.Number = 0 Then Set fld = qdf.Fields(strFieldName) GetFieldDataType = fld.Type Else GetFieldDataType = dbText End If End If On Error GoTo ErrHandler Exit Function ErrHandler: GetFieldDataType = dbText End Function ' === تنسيق المعلمات تلقائيًا بناءً على النوع Public Function FormatParameterValue(varValue As Variant, Optional ByVal dataType As Integer = 0) As String If IsNull(varValue) Or IsEmpty(varValue) Then FormatParameterValue = "NULL" Exit Function End If If dataType = 0 Then Select Case VarType(varValue) Case vbString FormatParameterValue = "'" & Replace(varValue, "'", "''") & "'" Case vbDate FormatParameterValue = "#" & Format(varValue, "mm\/dd\/yyyy") & "#" Case vbBoolean FormatParameterValue = IIf(varValue, "True", "False") Case vbNull, vbEmpty FormatParameterValue = "NULL" Case Else FormatParameterValue = CStr(varValue) End Select Else Select Case dataType Case dbText, dbMemo FormatParameterValue = "'" & Replace(varValue, "'", "''") & "'" Case dbLong, dbInteger, dbByte, dbDouble, dbSingle FormatParameterValue = CStr(varValue) Case dbDate FormatParameterValue = "#" & Format(varValue, "mm\/dd\/yyyy") & "#" Case dbBoolean FormatParameterValue = IIf(varValue, "True", "False") Case Else FormatParameterValue = "NULL" End Select End If End Function ' === تعقيم النصوص لتضمينها داخل استعلامات SQL Public Function SafeSql(strValue As String) As String If IsNull(strValue) Or Trim(strValue) = "" Then SafeSql = "NULL" Else SafeSql = "'" & Replace(strValue, "'", "''") & "'" End If End Function ' === توليد شرط تصفية ذكي بناءً على اسم الحقل والقيمة Public Function BuildFilter( _ ByVal strFieldName As String, _ ByVal varFieldValue As Variant, _ Optional ByVal strRecordSource As String = "") As String If IsNull(varFieldValue) Or IsEmpty(varFieldValue) Or Trim(CStr(varFieldValue)) = "" Then BuildFilter = vbNullString Exit Function End If Dim dataType As Integer If strRecordSource <> "" Then dataType = GetFieldDataType(strRecordSource, strFieldName) Else dataType = 0 ' Use VarType End If BuildFilter = strFieldName & " = " & FormatParameterValue(varFieldValue, dataType) End Function ' === استخراج قيمة من strFilter Private Function ExtractFilterValue(ByVal strFilter As String) As String If InStr(strFilter, "=") > 0 Then Dim strValue As String strValue = Trim(Mid(strFilter, InStr(strFilter, "=") + 1)) strValue = Replace(strValue, "'", "") strValue = Replace(strValue, "#", "") ExtractFilterValue = strValue Else ExtractFilterValue = "" End If End Function ' === التحقق مما إذا كان التقرير يحتوي على بيانات Private Function ReportHasData( _ ByVal strReportName As String, _ Optional ByVal strFilter As String = "", _ Optional ByVal strOpenArgs As String = "", _ Optional ByVal dictParameters As Object = Nothing, _ Optional ByVal bolUseCache As Boolean = True) As Boolean On Error GoTo ExitWithError Dim strDebugMsg As String Dim rpt As Report Dim dbs As DAO.Database Dim qdf As DAO.QueryDef Dim rst As DAO.Recordset Dim prm As DAO.Parameter Dim strRecordSource As String Dim strCacheKey As String Dim strFilterValue As String strDebugMsg = "Report: " & strReportName & vbCrLf & "Filter: " & strFilter & vbCrLf ' --- إنشاء قاموس التخزين المؤقت If m_dictHasDataCache Is Nothing Then Set m_dictHasDataCache = CreateObject("Scripting.Dictionary") End If strCacheKey = strReportName & "|" & strFilter If bolUseCache And m_dictHasDataCache.Exists(strCacheKey) Then ReportHasData = m_dictHasDataCache(strCacheKey) strDebugMsg = strDebugMsg & "Retrieved from Cache: " & ReportHasData & vbCrLf If mbolDebugMode Then Debug.Print strDebugMsg Exit Function End If ' --- الحصول على RecordSource strRecordSource = GetRecordSource(strReportName) If strRecordSource = "" Then strDebugMsg = strDebugMsg & "No RecordSource found" & vbCrLf GoTo OpenAndCheckWithHasData End If strDebugMsg = strDebugMsg & "RecordSource: " & strRecordSource & vbCrLf ' --- محاولة استخدام DCount On Error Resume Next If strFilter <> "" Then If DCount("*", strRecordSource, strFilter) > 0 Then ReportHasData = True m_dictHasDataCache(strCacheKey) = ReportHasData strDebugMsg = strDebugMsg & "DCount HasData: " & ReportHasData & vbCrLf If mbolDebugMode Then Debug.Print strDebugMsg Exit Function End If Else If DCount("*", strRecordSource) > 0 Then ReportHasData = True m_dictHasDataCache(strCacheKey) = ReportHasData strDebugMsg = strDebugMsg & "DCount HasData: " & ReportHasData & vbCrLf If mbolDebugMode Then Debug.Print strDebugMsg Exit Function End If End If Err.Clear On Error GoTo ExitWithError ' --- استخراج قيمة من strFilter إذا كانت موجودة strFilterValue = ExtractFilterValue(strFilter) strDebugMsg = strDebugMsg & "Extracted Filter Value: " & strFilterValue & vbCrLf ' --- محاولة التحقق باستخدام RecordSource Set dbs = CurrentDb On Error Resume Next Set qdf = dbs.QueryDefs(strRecordSource) If Err.Number = 0 And qdf.Parameters.Count > 0 Then strDebugMsg = strDebugMsg & "Parameters Count: " & qdf.Parameters.Count & vbCrLf For Each prm In qdf.Parameters strDebugMsg = strDebugMsg & "Parameter: " & prm.Name & vbCrLf If Not dictParameters Is Nothing And dictParameters.Exists(prm.Name) Then prm.Value = FormatParameterValue(dictParameters(prm.Name), prm.Type) strDebugMsg = strDebugMsg & "Assigned from dictParameters: " & prm.Value & vbCrLf ElseIf InStr(prm.Name, "Forms!") > 0 Then Dim strFormName As String strFormName = Split(prm.Name, "!")(1) If CurrentProject.AllForms(strFormName).IsLoaded Then prm.Value = Eval(prm.Name) strDebugMsg = strDebugMsg & "Assigned from Eval(" & prm.Name & "): " & prm.Value & vbCrLf Else strDebugMsg = strDebugMsg & "Form not loaded: " & strFormName & vbCrLf GoTo OpenAndCheckWithHasData End If ElseIf strFilterValue <> "" Then prm.Value = FormatParameterValue(strFilterValue, prm.Type) strDebugMsg = strDebugMsg & "Assigned from strFilterValue: " & prm.Value & vbCrLf Else strDebugMsg = strDebugMsg & "No value for parameter: " & prm.Name & vbCrLf GoTo OpenAndCheckWithHasData End If Next prm Set rst = qdf.OpenRecordset(dbOpenSnapshot, dbReadOnly) If Err.Number = 0 Then ReportHasData = Not rst.EOF strDebugMsg = strDebugMsg & "Recordset HasData: " & ReportHasData & vbCrLf rst.Close m_dictHasDataCache(strCacheKey) = ReportHasData If mbolDebugMode Then Debug.Print strDebugMsg Exit Function End If Err.Clear End If On Error GoTo ExitWithError OpenAndCheckWithHasData: ' --- فتح التقرير مؤقتًا في الخلفية (كملاذ أخير) DoCmd.OpenReport strReportName, acViewPreview, , strFilter, acHidden, strOpenArgs Set rpt = Reports(strReportName) ReportHasData = (rpt.HasData <> 0) strDebugMsg = strDebugMsg & "Report HasData: " & ReportHasData & vbCrLf DoCmd.Close acReport, strReportName m_dictHasDataCache(strCacheKey) = ReportHasData If mbolDebugMode Then Debug.Print strDebugMsg Exit Function ExitWithError: strDebugMsg = strDebugMsg & "Error: " & Err.Number & " - " & Err.Description & vbCrLf ReportHasData = True ' افتراض وجود بيانات إذا فشل التحقق If mbolDebugMode Then Debug.Print strDebugMsg End Function ' === دالة رئيسية لفتح التقارير الذكية Public Function OpenReportSmart( _ ByVal strReportName As String, _ Optional ByVal bolConfirm As Boolean = True, _ Optional ByVal enmView As AcView = acViewNormal, _ Optional ByVal strWhereCondition As String = vbNullString, _ Optional ByVal varOpenArgs As Variant, _ Optional ByVal bolSilentMode As Boolean = False, _ Optional ByVal dictParameters As Object = Nothing, _ Optional ByVal bolUseCache As Boolean = True, _ Optional ByVal bolSkipDataCheck As Boolean = False) As Boolean Const strTitleConfirm As String = "تأكيد" Const strTitleAlert As String = "تنبيه" Const strTitleError As String = "خطأ" Dim strFilter As String Dim strArgs As String Dim strRecordSource As String On Error GoTo ExitWithError ' --- التحقق من وجود التقرير If Not ReportExists(strReportName) Then If Not bolSilentMode Then MsgBox "التقرير '" & strReportName & "' غير موجود.", vbExclamation + vbMsgBoxRight + vbMsgBoxRtlReading, strTitleAlert End If OpenReportSmart = False Exit Function End If ' --- التحقق من RecordSource strRecordSource = GetRecordSource(strReportName) If strRecordSource = "" Then If Not bolSilentMode Then MsgBox "التقرير '" & strReportName & "' لا يحتوي على مصدر بيانات.", vbExclamation + vbMsgBoxRight + vbMsgBoxRtlReading, strTitleAlert End If OpenReportSmart = False Exit Function End If ' --- تنسيق الفلتر والمعلمات strFilter = Nz(strWhereCondition, vbNullString) If Not IsMissing(varOpenArgs) Then strArgs = CStr(varOpenArgs) ' --- التأكيد قبل الفتح If bolConfirm And Not bolSilentMode Then If MsgBox("هل تريد عرض التقرير: " & vbCrLf & strReportName & "؟", vbQuestion + vbYesNo + vbMsgBoxRight + vbMsgBoxRtlReading, strTitleConfirm) = vbNo Then OpenReportSmart = False Exit Function End If End If ' --- التحقق من وجود بيانات (إذا لم يُطلب تخطي التحقق) If Not bolSkipDataCheck Then If Not ReportHasData(strReportName, strFilter, strArgs, dictParameters, bolUseCache) Then If Not bolSilentMode Then MsgBox "التقرير لا يحتوي على بيانات.", vbInformation + vbMsgBoxRight + vbMsgBoxRtlReading, strTitleAlert End If OpenReportSmart = False Exit Function End If End If ' --- فتح التقرير DoCmd.OpenReport strReportName, enmView, , strFilter, , strArgs If mbolDebugMode Then Debug.Print "تم فتح التقرير: " & strReportName If strFilter <> "" Then Debug.Print ">> الفلتر: " & strFilter If strArgs <> "" Then Debug.Print ">> OpenArgs: " & strArgs End If OpenReportSmart = True Exit Function ExitWithError: Select Case Err.Number Case 2501, 2212 If Not bolSilentMode Then MsgBox "تم إلغاء عملية الطباعة أو تعذر العثور على التقرير.", vbExclamation + vbMsgBoxRight + vbMsgBoxRtlReading, strTitleAlert End If Case Else If Not bolSilentMode Then MsgBox "حدث خطأ أثناء فتح التقرير: " & Err.Number & " | " & Err.Description, vbExclamation + vbMsgBoxRight + vbMsgBoxRtlReading, strTitleError End If End Select OpenReportSmart = False End Function ودى دالة توثيقية لامثلة الاستدعاء المختلفة ' === دالة توثيقية: أمثلة استخدام OpenReportSmart Private Sub OpenReportSmart_Examples() #If False Then Dim strFilter As String Dim strRecordSource As String ' [01] استدعاء بسيط لفتح تقرير بدون فلتر أو تأكيد Call OpenReportSmart("rptEmployees", False) ' [02] فتح تقرير في وضع المعاينة مع تأكيد Call OpenReportSmart("rptEmployees", True, acViewPreview) ' [03] تصفية بسيطة باستخدام شرط ثابت Call OpenReportSmart("rptEmployees", True, acViewPreview, "DepartmentID = 5") ' [04] فتح تقرير مع OpenArgs لتمرير معلومات إضافية Call OpenReportSmart("rptEmployees", True, acViewPreview, , "ShowSummary") ' [05] فتح تقرير في الوضع الصامت (بدون رسائل خطأ) Call OpenReportSmart("rptEmployees", , , , , True) ' [06] استدعاء كامل مع فلتر، OpenArgs، وتأكيد Call OpenReportSmart("rptEmployees", True, acViewPreview, "IsActive = True", "FromMainMenu", False) ' [07] تصفية ديناميكية من نموذج باستخدام BuildFilter If CurrentProject.AllForms("frmEmployeeSelector").IsLoaded Then strRecordSource = GetRecordSource("rptEmployeeAttendance") strFilter = BuildFilter("EmployeeID", Forms!frmEmployeeSelector!cboEmployeeID, strRecordSource) Call OpenReportSmart("rptEmployeeAttendance", True, acViewNormal, strFilter) End If ' [08] تصفية بتاريخ باستخدام BuildFilter strRecordSource = GetRecordSource("rptDailySummary") strFilter = BuildFilter("ReportDate", Date, strRecordSource) Call OpenReportSmart("rptDailySummary", True, acViewPreview, strFilter) ' [09] تصفية بنص باستخدام BuildFilter Dim strEmployeeName As String strEmployeeName = "محمد علي" strRecordSource = GetRecordSource("rptEmployees") strFilter = BuildFilter("EmployeeName", strEmployeeName, strRecordSource) Call OpenReportSmart("rptEmployees", True, acViewPreview, strFilter) ' [10] فتح تقرير مع تخطي التحقق من البيانات (لتقليل التأخير) Call OpenReportSmart("rptEmployees", True, acViewPreview, , , , , , True) ' [11] مثال مشابه لـ rpt01StudentsLists مع فلتر Period If CurrentProject.AllForms("frmStudentsFilter").IsLoaded Then strRecordSource = GetRecordSource("rpt01StudentsLists") strFilter = BuildFilter("Period", Forms!frmStudentsFilter!cboPeriod, strRecordSource) Call OpenReportSmart("rpt01StudentsLists", True, acViewPreview, strFilter, Forms!frmStudentsFilter!cboPeriod) End If ' [12] فتح تقرير مع فلتر معقد وتخطي التحقق من البيانات strFilter = "DepartmentID = 5 AND IsActive = True" Call OpenReportSmart("rptEmployees", True, acViewPreview, strFilter, , , , , True) ' [13] فتح تقرير مع تعطيل التخزين المؤقت strRecordSource = GetRecordSource("rptEmployees") strFilter = BuildFilter("DepartmentID", 10, strRecordSource) Call OpenReportSmart("rptEmployees", True, acViewPreview, strFilter, , , , False) #End If End Sub

السلام عليكم ورحمة الله أشارك معكم اليوم أكواد داخل وحدة نمطية عامة تم تطويرها لتصفية محتويات أي مربع سرد (ComboBox) في أي نموذج بشكل ديناميكي بمجرد الكتابة داخل مربع التحرير والسرد تصفية ديناميكية: يدعم التصفية المتعددة باستخدام أكثر من حقل (مثل الاسم + الرقم القومي) تدعم التصفية على حقل واحد أو حقول متعددة باستخدام نمط LIKE '*...*' وذلك لتتم التصفية بناء على اى جزء من الكلمة الكود داخل الوحده النمطية العامة Option Compare Database Option Explicit Private dictRowSources As Object Private strLastFilterValue As String Private strLastComboName As String Private Sub EnsureDictionary() If dictRowSources Is Nothing Then Set dictRowSources = CreateObject("Scripting.Dictionary") End If End Sub Public Sub ClearComboMemory(ByVal frm As Access.Form) Dim strKey As Variant Call EnsureDictionary For Each strKey In dictRowSources.Keys If Left(strKey, Len(frm.Name) + 1) = frm.Name & "." Then dictRowSources.Remove strKey End If Next End Sub Public Sub FilterCombo(ByVal frm As Access.Form, _ ByVal strComboName As String, _ Optional ByVal strFilterField As String = "") Dim cmb As Access.ComboBox Dim strSourceSQL As String Dim strFilterValue As String Dim strFilteredSQL As String Dim strOrderByClause As String Dim strKey As String Dim objRegex As Object Dim objMatches As Object Dim arrFilterFields As Variant Dim strWhereClause As String Dim i As Long On Error GoTo ExitWithError ' التحقق من صحة النموذج وعنصر التحكم If frm Is Nothing Then MsgBox "النموذج غير صالح.", vbExclamation Exit Sub End If ' Debug.Print "Form: " & frm.Name ' Debug.Print "ComboBox: " & strComboName Set cmb = frm.Controls(strComboName) ' التحقق من مصدر البيانات Call EnsureDictionary strKey = frm.Name & "." & cmb.Name If dictRowSources.Exists(strKey) Then strSourceSQL = dictRowSources(strKey) Else strSourceSQL = Trim(Replace(cmb.RowSource & "", ";", "")) ' إزالة الفاصلة المنقوطة ' Debug.Print "RowSource: " & strSourceSQL If Len(strSourceSQL) = 0 Then MsgBox "مصدر البيانات غير صالح.", vbExclamation Exit Sub End If dictRowSources.Add strKey, strSourceSQL End If ' إعادة تعيين المصدر إذا لم يتم توفير حقل تصفية If Len(strFilterField) = 0 Then If cmb.RowSource <> strSourceSQL Then cmb.RowSource = strSourceSQL End If cmb.Requery cmb.Dropdown strLastFilterValue = "" strLastComboName = strComboName Exit Sub End If ' التحقق من نوع عنصر التحكم النشط If TypeOf Screen.ActiveControl Is Access.TextBox Or TypeOf Screen.ActiveControl Is Access.ComboBox Then strFilterValue = Nz(Screen.ActiveControl.Text, vbNullString) ' Debug.Print "ActiveControl: " & Screen.ActiveControl.Name ' Debug.Print "FilterValue: " & strFilterValue Else ' Debug.Print "ActiveControl is not TextBox or ComboBox" If cmb.RowSource <> strSourceSQL Then cmb.RowSource = strSourceSQL End If cmb.Requery cmb.Dropdown strLastFilterValue = "" strLastComboName = strComboName Exit Sub End If ' إعادة تعيين المصدر إذا كانت القيمة المصفاة فارغة If Len(strFilterValue) = 0 Then If cmb.RowSource <> strSourceSQL Then cmb.RowSource = strSourceSQL End If cmb.Requery cmb.Dropdown strLastFilterValue = "" strLastComboName = strComboName Exit Sub End If ' التحقق مما إذا كانت القيمة المصفاة أو ComboBox قد تغيرت If strFilterValue = strLastFilterValue And strComboName = strLastComboName Then cmb.Requery cmb.Dropdown Exit Sub End If ' استخدام Regex لاستخراج ORDER BY Set objRegex = CreateObject("VBScript.RegExp") With objRegex .Global = True .IgnoreCase = True .Pattern = "\s*ORDER\s+BY\s+.*$" End With Set objMatches = objRegex.Execute(strSourceSQL) If objMatches.Count > 0 Then strOrderByClause = objMatches(0).Value strSourceSQL = Trim(Replace(strSourceSQL, strOrderByClause, "")) Else strOrderByClause = "" End If ' Debug.Print "SourceSQL: " & strSourceSQL ' Debug.Print "OrderBy: " & strOrderByClause ' التحقق من الحقول وإنشاء شرط WHERE لحقول متعددة If Len(strFilterField) > 0 Then arrFilterFields = Split(strFilterField, ",") strWhereClause = "" For i = LBound(arrFilterFields) To UBound(arrFilterFields) Dim strField As String strField = Trim(arrFilterFields(i)) If Len(strField) > 0 Then If Len(strWhereClause) > 0 Then strWhereClause = strWhereClause & " OR " strWhereClause = strWhereClause & strField & " LIKE '*" & Replace(strFilterValue, "'", "''") & "*'" End If Next i If Len(strWhereClause) = 0 Then MsgBox "تعبير التصفية غير صالح: " & strFilterField, vbExclamation Exit Sub End If On Error Resume Next strFilteredSQL = strSourceSQL & " WHERE (" & strWhereClause & ")" & strOrderByClause ' Debug.Print "FilteredSQL: " & strFilteredSQL cmb.RowSource = strFilteredSQL If Err.Number <> 0 Then MsgBox "تعبير التصفية غير صالح: " & strFilterField & vbCrLf & "Error: " & Err.Description, vbExclamation On Error GoTo ExitWithError Exit Sub End If On Error GoTo ExitWithError Else strFilteredSQL = strSourceSQL & strOrderByClause cmb.RowSource = strFilteredSQL End If ' تعيين المصدر المصفى وتحديث واجهة المستخدم cmb.Requery cmb.Dropdown strLastFilterValue = strFilterValue strLastComboName = strComboName Exit Sub ExitWithError: Select Case Err.Number Case 2118 Resume Next Case Else MsgBox "حدث خطأ أثناء التصفية: " & Err.Number & " | " & Err.Description, vbExclamation End Select End Sub الاستدعاء فى النموذج في حدث Click : لإعادة تحميل القائمة الأصلية لمربع السرد عند الضغط عليه ' في حدث Click Private Sub ComboBoxName_Click() FilterCombo Me, "ComboBoxName" End Sub وايضا في حدث KeyUp : لتصفية القيم أثناء الكتابة في مربع السرد حسب حقل واحد ' في حدث KeyUp Private Sub ComboBoxName_KeyUp(KeyCode As Integer, Shift As Integer) FilterCombo Me, "ComboBoxName", "FieldName" End Sub مع امكانية في حدث KeyUp : لتصفية القيم أثناء الكتابة في مربع السرد حسب أكثر من حقل ' في حدث KeyUp لعمل التصفية المتعددة Private Sub ComboBoxName_KeyUp(KeyCode As Integer, Shift As Integer) FilterCombo Me, "ComboBoxName", "FieldName, FieldName2" End Sub تحياتى Filter inside the Combobox.accdb

وعليكم السلام ورحمة الله وبركاته وبخصوص شرح جملة الاستعلام الموضوع بيعتمد على مقارنة بين سجلات الجدول نفسه باستخدام دالة EXISTS واستعلام فرعي الاستعلام يقوم بتحديث جدول tblEshtrakatTsdeed وبالتحديد الحقل jad بحيث يتم تعيين قيمته إلى True للسجلات التي تستوفي شرط معينه الشرط يعتمد على مقارنة بين سجلات الجدول نفسه من خلال استعلام فرعي Subquery خلينى أفصل مكونات الاستعلام علشان نبسط الدنيا شوية جزء التحديث : UPDATE UPDATE tblEshtrakatTsdeed AS t1 SET t1.jad = True تم استخدام AS t1 لإعطاء الجدول اسم مستعار :t1 لتسهيل الإشارة إليه داخل الاستعلام خاصة عند مقارنة سجلات الجدول نفسه و يتم تعيين قيمة العمود jad إلى True للسجلات التي تحقق الشرط شرط التحديث WHERE EXISTS ( SELECT 1 FROM tblEshtrakatTsdeed AS t2 WHERE t2.usrID = t1.usrID AND t2.lstDate > t1.lstDate ) هذا الشرط يحدد السجلات في الجدول tblEshtrakatTsdeed (المحدد باسم t1) سيتم تحديثها بناء على وجود سجلات أخرى في نفس الجدول المحدد باسم :t2 والتى تحقق شروط معينة دالة EXISTS: تتحقق مما إذا كان هناك سجل واحد على الأقل في الاستعلام الفرعي يحقق الشرط ليتم تحديث السجل في t1 الاستعلام الفرعي: SELECT 1 FROM tblEshtrakatTsdeed AS t2 WHERE t2.usrID = t1.usrID AND t2.lstDate > t1.lstDate SELECT 1: في استعلامات بها دالة EXISTS بدلا من استرجاع بيانات فعلية يتم إرجاع قيمة ثابتة (1) لأننا نهتم فقط بوجود السجل وليس بمحتواه FROM tblEshtrakatTsdeed AS t2: نفس الجدول tblEshtrakatTsdeed ولكن باسم مستعار مختلف:t2 وذلك حتى نستطيع تمييزه عن t1 الشرط: t2.usrID = t1.usrID: يتطابق معرف المستخدم (usrID) بين السجل في t1 والسجل في t2 هذا يعني أننا نبحث عن سجلات لنفس المستخدم t2.lstDate > t1.lstDate: يتحقق مما إذا كان تاريخ السجل في t2 (الموجود في العمود lstDate) أحدث (أكبر) من تاريخ السجل في t1

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

تم تعديل المرفق ليعمل على جميع الانوية ضبط النموذج على الشاشة.accdb

وعليكم السلام ورحمة الله تعالى وبركاته اتفضل يا والدى الحبيب و استاذى الجليل و معلمى القدير استاذ @ابوخليل الاستعلام الاول فقط ومنفردا سوف يلبى رغبتك تماما : ينفذ طلبك تماما --------------------------- والاستعلام الثانى: لحذف اى تأشير عن السجل الذي يحمل أحدث تاريخ لكل usrID يمكن استخدامه قبل او بعد الاستعلام الاول كإجراء تصحيح ان اردت لو تم اى تأشير عن طريق الخطأ أو ممكن عمل استعلام تحديث للتأشير على الكل والاستعلام الثانى يقوم بالمهمة المطلوبة مثلا - شغل الاستعلام الثالث اولا للتأشير على الجميع -ثم الاستعلام الثانى لحذف اى تأشير عن السجل الذي يحمل أحدث تاريخ لكل usrID النتيجة : testData -2.accdb

اه حضرتك تقصد كود الوحدة النمطية العامة

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