Debug Ace

البساطة حلوة مفيش كلام بس بما انك عاوز الافكار برة الصندوق شوف تنفيذها بالشكل ده تجربة.accdb

وربنا انا مش فاهم انت عاوز ايه

المرفق VBAMonitor.accdb

هعيد رقعه بأعدل حبة حجات ثوانى

انت بتقول ايه ؟ هتخرج معاش قبل ما تتولد ؟ على العموم انظر الى الموضوع التالى

انا مش فاهم حاجة

الفكرة اللى انت مصور بيها الصورة

فكرتك بتعتمد على حدث فى التيمر ؟؟

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

تمام وفقت ووفيت وكفيت وبعد اذنك انا حبيت ان اضع الشرح بالتفصيل الممل بعدكم واللى كنت عارفه بس ما حبيت اسبقكم اولا لازم نفهم ايه السحر اللى هنا ونفك الطلاسم دى ازاى علشان نفهم اللى بيحصل اولا انا عملت : Documenter للجدول ده وهو اللى كان فى اول مشاركة علشان بس اعرف هل فى اى حيل مخفية يعنى اختصارا للوقت والجهد وده اللى وضح كل شئ وهو كالاتى : تم تعريف الـ RowSource في الحقل على مستوى الـ ACE/Jet Engine مباشرة تم تغيير DisplayControl إلى Text Box تغيير DisplayControl أخفى القيم من واجهة Lookup Tab أى ان القيم لن تظهر فى وضع التصميم ولكنها ظلت محفوظة في مخطط الجدول ( schema ) طيب عرفنا البيانات وعرفنا فين محفوظة والحمد لله نوضح نقطة مهمة الاول قبل ما ننتقل للاضافة والحذف خاصية الإرث (inheritance) فى خصائص مربع التحرير والسرد يجب ان تكون مفعلة والا لن تظهر القائمة فى وقت العرض Runtime طيب الاضافة بطريقة الاستاذ منتصر او الافضل من خلال كود زى ده اولا الدوال الرئيسية لاضافة او تحديث او ازالة الخصائص Private Sub AddOrUpdateProperty(fld As DAO.Field, _ propName As String, _ propType As Integer, _ propValue As Variant) On Error GoTo ErrHandler fld.Properties(propName) = propValue GoTo ExitProc ErrHandler: If Err.Number = 3270 Then Err.Clear On Error GoTo ErrCreate Dim prp As DAO.Property Set prp = fld.CreateProperty(propName, propType, propValue) fld.Properties.Append prp GoTo ExitProc End If MsgBox "خطأ في AddOrUpdateProperty:" & vbCrLf & Err.Description, vbCritical ErrCreate: MsgBox "فشل إنشاء الخاصية " & propName & ":" & vbCrLf & Err.Description, vbCritical ExitProc: Set prp = Nothing End Sub Private Sub DeletePropIfExists(fld As DAO.Field, propName As String) On Error GoTo ErrHandler Dim prp As DAO.Property For Each prp In fld.Properties If prp.Name = propName Then fld.Properties.Delete propName GoTo ExitProc End If Next prp GoTo ExitProc ErrHandler: MsgBox "فشل حذف " & propName & ":" & vbCrLf & Err.Description, vbCritical ExitProc: Set prp = Nothing End Sub ثانيا : دوال الاضافة والحذف Public Sub AddHiddenFieldProperties() On Error GoTo ErrHandler Dim db As DAO.Database Dim tdf As DAO.TableDef Dim fld As DAO.Field Set db = CurrentDb Set tdf = db.TableDefs("TableName") Set fld = tdf.Fields("FieldName") ' DisplayControl = 109 (Combo مخفي) / 110 (Combo ظاهر) fld.Properties("DisplayControl") = 109 AddOrUpdateProperty fld, "RowSourceType", dbText, "Value List" AddOrUpdateProperty fld, "RowSource", dbText, _ """آسيا"";""أفريقيا"";""أوروبا"";""أمريكا الشمالية"";""أمريكا الجنوبية""" db.TableDefs.Refresh MsgBox "تم إضافة قائمة القيم المخفية بنجاح!", vbInformation GoTo ExitProc ErrHandler: MsgBox "فشلت العملية: " & Err.Description, vbCritical ExitProc: Set fld = Nothing Set tdf = Nothing Set db = Nothing End Sub Public Sub DeleteFieldProperties() On Error GoTo ErrHandler Dim db As DAO.Database Dim tdf As DAO.TableDef Dim fld As DAO.Field Set db = CurrentDb Set tdf = db.TableDefs("TableName") Set fld = tdf.Fields("FieldName") DeletePropIfExists fld, "RowSource" DeletePropIfExists fld, "RowSourceType" db.TableDefs.Refresh MsgBox "تم الحذف بنجاح!", vbInformation GoTo ExitProc ErrHandler: MsgBox "فشل الحذف: " & Err.Description, vbCritical ExitProc: Set fld = Nothing Set tdf = Nothing Set db = Nothing End Sub وبكده نقدر نقول التالى فى الاجابة ببساطة 1. كيف تم إضافة عناصر القائمة؟ من احد الطرق السابقة اما بطريقة الاستاذ : منتصر الانسي أو من خلال الاكواد السابقة 2- كيف يمكن حذف تلك العناصر؟ اما بطريقة الاستاذ : منتصر الانسي أو من خلال الاكواد السابقة 3- أين يتم حفظ القائمة؟ فى الجدول في خصائص الحقل على مستوى الـ ACE/Jet Engine مباشرة و تم تغيير DisplayControl إلى Text Box لتظل محفوظة في مخطط الجدول ( schema )

وفين اجابة ال 3 اسئلة استاذ ؟

1. كيف تم إضافة عناصر القائمة؟ بنفس الطريقة اللى انا عملت بيها قاعدة وجدول وحقل و نموذج ومربع سرد و كله جديد X جديد واضفت البيانات 2- كيف يمكن حذف تلك العناصر؟ زى ما اضفنا البيانات نخذفها 3- أين يتم حفظ القائمة؟ فى الجدول

Magic.accdb

ههههههههههههههههههههه طيب نتناقش بعد ما تشوفوا ده C:\Users\000000\Desktop\لغز.accdb Thursday, March 12, 2026 Table: Table1 Page: 1 Properties AlternateBackShade: 95 AlternateBackThemeC 1 AlternateBackTint: 100 BackShade: 100 BackTint: 100 DatasheetForeTheme 0 DatasheetGridlinesThe 3 DateCreated: 3/12/2026 2:41:20 AM DefaultView: 2 DisplayViewsOnShare 1 FilterOnLoad: False GUID: {انا حذفته HideNewField: False LastUpdated: 3/12/2026 2:43:11 AM NameMap: Long binary data OrderByOn: False OrderByOnLoad: True Orientation: Left-to-Right PublishToWeb: 1 ReadOnlyWhenDiscon False RecordCount: 1 ThemeFontIndex: 1 TotalsRow: False Updatable: True Columns Name Type Size ID Long Integer 4 AggregateType: -1 AllowZeroLength: False AppendOnly: False Attributes: Fixed Size, Auto-Increment CollatingOrder: General ColumnHidden: False ColumnOrder: Default ColumnWidth: Default CurrencyLCID: 0 DataUpdatable: False GUID: {انا حذفته} OrdinalPosition: 0 Precision: 1033 Required: False ResultType: 0 Scale: 0 SourceField: ID SourceTable: Table1 TextAlign: General Field1 Short Text 255 AggregateType: -1 AllowZeroLength: True AppendOnly: False Attributes: Variable Length CollatingOrder: General ColumnHidden: False ColumnOrder: Default ColumnWidth: Default CurrencyLCID: 0 DataUpdatable: False DisplayControl: Text Box GUID: {انا حذفته} C:\Users\00000\Desktop\لغز.accdb Thursday, March 12, 2026 Table: Table1 Page: 2 IMEMode: 0 IMESentenceMode: 3 OrdinalPosition: 1 Precision: 1033 Required: False ResultType: 0 RowSource: "آسيا";"أفريقيا";"أوروبا";"أمريكا الشمالية";"أمريكا الجنوبية";" Scale: 0 SourceField: Field1 SourceTable: Table1 TextAlign: General UnicodeCompression: True Table Indexes Name Number of Fields PrimaryKey 1 Clustered: False DistinctCount: 1 Foreign: False IgnoreNulls: False Name: PrimaryKey Primary: True Required: True Unique: True Fields: ID Ascending User Permissions admin Delete, Read Permissions, Set Permissions, Change Owner, Read Definition, Write Definition, Read Data, Insert Data, Update Group Permissions Admins Delete, Read Permissions, Set Permissions, Change Owner, Read Definition, Write Definition, Read Data, Insert Data, Update Users Delete, Read Permissions, Set Permissions, Change Owner, Read Definition, Write Definition, Read Data, Insert Data, Update

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

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

في هذا الموضوع سنستعرض دالتين احترافيتين CountWeekday – لحساب عدد أيام محددة بين تاريخين CalculateMonthStats – لحساب إحصائيات شهرية لأي فترة زمنية الدوال مرنة، سريعة، وصحيحة حتى في الفترات الطويلة، ويمكن استخدامها لأي يوم من أيام الأسبوع وليس فقط الجمعة والسبت تعريف أيام الأسبوع Public Enum WeekDays wdSunday = 1 wdMonday = 2 wdTuesday = 3 wdWednesday = 4 wdThursday = 5 wdFriday = 6 wdSaturday = 7 End Enum دالة CountWeekday تحسب عدد أي يوم تختاره بين تاريخين مرنة: يمكن استخدامها لحساب أيام الأحد، الإثنين، الأربعاء، الجمعة … إلخ. سريعة وفعّالة دون الحاجة لتكرار كل يوم في الفترة. تتعامل مع التاريخ بشكل صحيح . الكود Public Function CountWeekday( _ ByVal StartDate As Date, _ ByVal EndDate As Date, _ ByVal TargetDay As WeekDays) As Long Dim TotalDays As Long, BaseCount As Long, ExtraDays As Long Dim FirstDay As Long, Offset As Long If StartDate > EndDate Then Exit Function TotalDays = DateDiff("d", StartDate, EndDate) + 1 If TotalDays <= 0 Then Exit Function BaseCount = TotalDays \ 7 ExtraDays = TotalDays Mod 7 FirstDay = Weekday(StartDate, vbSunday) Offset = (TargetDay - FirstDay + 7) Mod 7 CountWeekday = BaseCount If Offset < ExtraDays Then CountWeekday = CountWeekday + 1 End Function ------ دالة CalculateMonthStats تحسب إحصائيات الشهر: عدد الأيام الإجمالي عدد أيام الجمعة والسبت (يمكن تعديلها لأي أيام أخرى) عدد أيام العمل (باقي الأيام) الكود Public Type TMonthStats MonthName As String CalendarYear As Long FridayCount As Long SaturdayCount As Long TotalDays As Long WorkingDays As Long End Type Public Const MONTH_NAMES_AR As String = "يناير,فبراير,مارس,ابريل,مايو,يونيو,يوليو,أغسطس,سبتمبر,اكتوبر,نوفمبر,ديسمبر" Public Function GetArabicMonthName(ByVal MonthNumber As Long) As String Static arrMonths As Variant If IsEmpty(arrMonths) Then arrMonths = Split(MONTH_NAMES_AR, ",") If MonthNumber >= 1 And MonthNumber <= 12 Then GetArabicMonthName = arrMonths(MonthNumber - 1) End Function Public Function CalculateMonthStats( _ ByVal StartDate As Date, _ ByVal EndDate As Date, _ ByVal MonthNumber As Long, _ ByVal YearNumber As Long) As TMonthStats Dim result As TMonthStats result.MonthName = GetArabicMonthName(MonthNumber) result.CalendarYear = YearNumber result.TotalDays = DateDiff("d", StartDate, EndDate) + 1 result.FridayCount = CountWeekday(StartDate, EndDate, wdFriday) result.SaturdayCount = CountWeekday(StartDate, EndDate, wdSaturday) result.WorkingDays = result.TotalDays - result.FridayCount - result.SaturdayCount CalculateMonthStats = result End Function مميزات الدوال مرنة: تعمل لأي يوم تختاره سريعة وفعالة: تعتمد على القسمة والحسابات الرياضية صحيحة للفترات الطويلة: سواء أيام، أشهر أو سنوات تحقق تلقائي: لا تنتج أخطاء إذا كان تاريخ البداية أكبر من النهاية سهل التعديل: يمكن استخدام CountWeekday لحساب أيام محددة أخرى داخل CalculateMonthStats الفكرة العامة: باستخدام هاتين الدالتين، يمكنك: حساب عدد أي يوم من أيام الأسبوع بين تاريخين. بناء تقارير شهرية مع إحصاءات كاملة لأيام العمل والعطلات. التحكم الكامل في تحديد أيام العطلات أو الأيام المستثناة حسب الحاجة. وممكن التجربة من خلال الاكواد التالية '------------------------------------------------- ' اختبار حساب عدد أيام يوم محدد في فترة '------------------------------------------------- Public Sub TestCountSingleWeekday() Dim StartDate As Date Dim EndDate As Date Dim TargetDay As WeekDays Dim Count As Long ' مثال: من 1 مارس 2025 إلى 31 مارس 2025 StartDate = DateSerial(2025, 3, 1) EndDate = DateSerial(2025, 3, 31) ' اليوم المطلوب: الجمعة TargetDay = wdFriday ' حساب عدد الأيام Count = CountWeekday(StartDate, EndDate, TargetDay) ' طباعة النتيجة في النافذة الفورية Debug.Print "==============================" Debug.Print "اختبار CountWeekday:" Debug.Print "الفترة من: " & FormatDateValue(StartDate) Debug.Print "إلى: " & FormatDateValue(EndDate) Debug.Print "اليوم المطلوب: " & WeekdayName(TargetDay) Debug.Print "عدد الأيام: " & Count Debug.Print "==============================" End Sub '------------------------------------------------- ' اختبار حساب أكثر من يوم (مثلاً الجمعة والسبت) '------------------------------------------------- Public Sub TestCountMultipleWeekdays() Dim StartDate As Date Dim EndDate As Date Dim FridayCount As Long Dim SaturdayCount As Long ' مثال: من 1 أبريل 2025 إلى 30 أبريل 2025 StartDate = DateSerial(2025, 4, 1) EndDate = DateSerial(2025, 4, 30) ' حساب كل يوم على حدة FridayCount = CountWeekday(StartDate, EndDate, wdFriday) SaturdayCount = CountWeekday(StartDate, EndDate, wdSaturday) ' طباعة النتائج Debug.Print "==============================" Debug.Print "اختبار CountWeekday لعدة أيام:" Debug.Print "الفترة من: " & FormatDateValue(StartDate) Debug.Print "إلى: " & FormatDateValue(EndDate) Debug.Print "عدد أيام الجمعة: " & FridayCount Debug.Print "عدد أيام السبت: " & SaturdayCount Debug.Print "==============================" End Sub '------------------------------------------------- ' اختبار حساب كامل إحصاءات الشهر '------------------------------------------------- Public Sub TestCalculateMonthStats() Dim Stats As TMonthStats Dim StartDate As Date Dim EndDate As Date ' مثال: مارس 2025 كامل StartDate = DateSerial(2025, 3, 1) EndDate = DateSerial(2025, 3, 31) Stats = CalculateMonthStats(StartDate, EndDate, Month(StartDate), Year(StartDate)) ' طباعة النتائج Debug.Print "==============================" Debug.Print "اختبار CalculateMonthStats:" Debug.Print "الشهر: " & Stats.MonthName & " - " & Stats.CalendarYear Debug.Print "إجمالي الأيام: " & Stats.TotalDays Debug.Print "أيام الجمعة: " & Stats.FridayCount Debug.Print "أيام السبت: " & Stats.SaturdayCount Debug.Print "أيام العمل: " & Stats.WorkingDays Debug.Print "==============================" End Sub '================================================= ' دالة اختبار عدد أيام أي يوم من الأحد إلى الخميس '================================================= Public Sub TestCountWeekdaysOtherThanFriSat() Dim StartDate As Date Dim EndDate As Date Dim TargetDay As WeekDays Dim Count As Long ' مثال للفترة: من 1 مارس 2025 إلى 31 مارس 2025 StartDate = DateSerial(2025, 3, 1) EndDate = DateSerial(2025, 3, 31) Debug.Print "==============================" Debug.Print "اختبار CountWeekday للأيام غير الجمعة والسبت:" Debug.Print "الفترة من: " & FormatDateValue(StartDate) Debug.Print "إلى: " & FormatDateValue(EndDate) ' التجربة لجميع الأيام من الأحد إلى الخميس For TargetDay = wdSunday To wdThursday Count = CountWeekday(StartDate, EndDate, TargetDay) Debug.Print WeekdayName(TargetDay) & ": " & Count Next TargetDay Debug.Print "==============================" End Sub '================================================= ' دالة اختبار عدد أيام أي يوم من الأحد إلى الخميس (باستثناء الثلاثاء) '================================================= Public Sub TestCountWeekdaysExceptTuesday() Dim StartDate As Date Dim EndDate As Date Dim TargetDay As WeekDays Dim Count As Long ' الفترة الزمنية للاختبار StartDate = DateSerial(2025, 3, 1) EndDate = DateSerial(2025, 3, 31) Debug.Print "==============================" Debug.Print "اختبار CountWeekday للأيام الأحد-الإثنين-الأربعاء-الخميس (باستثناء الثلاثاء)" Debug.Print "الفترة من: " & FormatDateValue(StartDate) Debug.Print "إلى: " & FormatDateValue(EndDate) ' التجربة لجميع الأيام من الأحد إلى الخميس مع استثناء الثلاثاء For TargetDay = wdSunday To wdThursday If TargetDay <> wdTuesday Then Count = CountWeekday(StartDate, EndDate, TargetDay) Debug.Print WeekdayName(TargetDay) & ": " & Count End If Next TargetDay Debug.Print "==============================" End Sub اطيب الامانى

دى الاجابة اللى اوصى بيها حساب الجمعة والسبت(V3).accdb

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

للاسف 95 بس ما تكفى ولا توفى 1+1=2 ما يصير نقول ونحكى ان 1+1 ممكن =1.95 ونستدل بمثل زى ده على هذه الحالة تحياتى

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

هو مش واضح ان فى وميض فى صور التجارب ؟ واللا انت تقصد ان الوميض لازم يكون موجود بنسبة 101%