ابو جودي

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

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

السلام عليكم ورحمة الله تعالى وبركاته استاذى الجليل ومعلمى القدير و والدى الحبيب الاستاذ @jjafferr ممكن أعرف إيه هى المشكله اللى حضرتك حصلت عليها

هلا والله ... والله اشتقنا للأسف انا لم أكن اعرف المطلوب وضعت الإجابة بناء على السؤال حلوه النماذج الجميله اللى بتغير الوانها دى👍 بس فكرتى احلى 🤪 هو كده غلاسه 😆🫣

استاذى الجليل و معلمى القدير و والدى الحبيب الاستاذ @ابوخليل أهديكم هذا المرفق يحتوى على الساعتين الرقمية والعقارب وبدون حدث الوقت وبه هديه لتغيير ثيم النموذج كذلك AnalogClock Without Timer Event.zip

استاذى الجليل و معلمى القدير و والدى الحبيب دوال api لا يتم الاعلان عنها داخل النماذج او بشكل ادق وأصح : AddressOf لابد ان يكون داخل وحده نمطيه عامة

وعليكم السلام ورحمة الله تعالى وبركاته استاذى الجليل و معلمى القدير و والدى الحبيب الكود التالى فى وحده نمطية عامة Option Compare Database Option Explicit #If VBA7 Then Private Declare PtrSafe Function SetTimer Lib "user32" _ (ByVal hWnd As LongPtr, ByVal nIDEvent As LongPtr, _ ByVal uElapse As Long, ByVal lpTimerFunc As LongPtr) As LongPtr Private Declare PtrSafe Function KillTimer Lib "user32" _ (ByVal hWnd As LongPtr, ByVal nIDEvent As LongPtr) As Long #Else Private Declare Function SetTimer Lib "user32" _ (ByVal hWnd As Long, ByVal nIDEvent As Long, _ ByVal uElapse As Long, ByVal lpTimerFunc As Long) As Long Private Declare Function KillTimer Lib "user32" _ (ByVal hWnd As Long, ByVal nIDEvent As Long) As Long #End If Private lngTimerID As LongPtr Private frmTargetClock As Form Public Sub StartSystemClock(frm As Form) Set frmTargetClock = frm lngTimerID = SetTimer(0, 0, 1000, AddressOf TimerProc) End Sub Public Sub StopSystemClock() If lngTimerID <> 0 Then KillTimer 0, lngTimerID lngTimerID = 0 End If End Sub Private Sub TimerProc(ByVal hWnd As LongPtr, ByVal uMsg As Long, ByVal idEvent As LongPtr, ByVal dwTime As Long) If Not frmTargetClock Is Nothing Then frmTargetClock!lblClock.Caption = Format(Now, "hh:nn:ss AM/PM") Else StopSystemClock End If End Sub الاحدات فى النموذج Option Compare Database Option Explicit Private Sub Form_Load() Call StartSystemClock(Me) End Sub Private Sub Form_Unload(Cancel As Integer) Call StopSystemClock End Sub المرفق Clock Without Timer Event.accdb

ما انت لو وضعت كود انشاء الجداول مكنش حصل كده

تم التحميل وجارى التجربة ان شاء الله

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

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

E server or ActiveX A problem occurred while Microsoft Access was communicating with the OLE server or ActiveX Control التفسير المحتمل: هنا Access فشل في التواصل مع OLE Server (زي تحكم ActiveX) أو عنصر زي مستعرض ويب أو عنصر رسومي مدمج. يظهر غالبًا بعد: تحديثات النظام أو الأوفيس غير المتوافقة فقدان أو تلف في ActiveX Control المستخدم داخل النماذج تعريف خاطئ أو غير مُسجل (Unregistered ActiveX DLL/OCX) استخدام WebBrowser, TreeView, Calendar Control, أو غيره من العناصر القديمة مشكلة اعدادات اللغة لو تم تنصيب نسخة ويندوز جديدة ------------------- There isn't enough memory to complete the Automation object operation on the | object. التفسير المحتمل: المقصود هنا أن Access فشل في تنفيذ عملية Automation Object (زي التعامل مع Excel أو Word من خلال كائنات Automation). السبب الأساسي بيكون: نقص فعلي في الذاكرة أو تسريب في الموارد (Memory Leak) أو نتيجة تحديث للأوفيس أو ويندوز أفسد الـ References (زي مكتبة MS Excel xx.0 Object Library) أو وجود كائن غير مُهيأ Properly قبل الاستخدام

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

انت فاهم غلط الدعم مش هيكون مجانى هيكون مدفوع يعنى بدون دفع مفيش دعم

السلام عليكم ولكن نصيحة انصحكم بها ويندوز 10 سوف يتم ايقاف الدعم عنه فى اكتوبر القادم من اجل ذلك التحديث تم الى ويندوز 11 بشكل صارم وسوف يأتى عليه وقت وكما هو الحال مع ويندوز 7 الان لن تجد المتصفحات مدعومة ولا بعض البرامج فى المستقبل مع ويندوز 10 كما هو الحال الان مع ويندوز 7 و ويندوز XP

انا ممكن اروح الشغل واضل بالشغل من 8 ساعات الى مبيت ل يوم او 2 او 3 احيانا وقد يزيد ان تطلب الامر أكثر من ذلك لذلك أنا أخبرك عن تحليلات و تجارب من وقائع حقيقيه هناك اصحاب عمل او فى مؤسسات معينه يستمر فيها العمل ليوم ونصف او يوميين او اكثر ان تطلب الامر وحسب الحاجة وبالاخص على ابواب المواسم والاعياد

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

إذا سجل الموظف حضورا اليوم و خرج بدون انصراف ثم عاد بعد أسبوع لتسجيل بصمة فسيتم اعتبار البصمة الأولى حضور والثانية انصراف مما يؤدي إلى حساب ساعات عمل غير منطقية (أسبوع كامل) وبالنسبه للسؤال: كيف ستحسب ساعات العمل في هذه الحالة؟ وحضرتك تفضلت قائلا تحليلي: المشكلة حقيقية: في الخيار الثاني حيث البصمات متتالية (زوجي=حضور، فردي=انصراف) إذا نسي الموظف تسجيل انصراف وعاد بعد فترة طويلة سيتم ربط الحضور القديم بالانصراف الجديد مما يعطي ساعات عمل غير واقعية الحلول الممكنة:تحديد مهلة زمنية: عند حساب ساعات العمل استبعد الأزواج (حضور-انصراف) التي يزيد الفرق بينها عن حد معقول (مثل 15 ساعه أو مثل 24 ساعة) من خلال استعلام طيب مشكلة : ضابط يومي إذا أردت ضابط يومي يمكن تصفية البصمات حسب التاريخ في الاستعلامات لكن هذا يتعارض مع فكرة العملية المفتوحة بدلا من ذلك ممكن استخدام المهلة الزمنية اللى اقترحتها على حضرتك من شوية الخيار الثاني لا يزال الأفضل لأنه: يتماشى مع طبيعة العملية المفتوحة (15 ساعة+ عبر أيام) يتعامل مع البصمات المفقودة باستعلامات بسيطة ومهلة زمنية (مثل 15 ساعه أو مثل 24 ساعة) بدلا من برمجة معقدة لا يعتمد على افتراضات صارمة مثل إكمال EndTime عند العودة مقارنة الخيارين : الخيار الأول: إيجابيات: مباشر لحساب ساعات العمل إذا كانت السجلات مكتملة مع برمجة محكمة (مثل إجبار إكمال EndTime عند العودة) يمكن معالجة السجلات المفتوحة سلبيات: أقل مرونة لفترات العمل الطويلة (15 ساعة+) أو التي تمتد عبر أيام يتطلب برمجة إضافية لإدارة EndTime الفارغ والتأكد من التسلسل لا يزال غير مثالي لعملية مفتوحة حقا حيث قد تظل السجلات مفتوحة لفترات طويلة تقييم: يعمل إذا كنت مستعدا لاستثمار وقت في برمجة نموذج ومعالجات إضافية لكنه أقل مرونة الخيار الثاني: إيجابيات: مرن جدا لعملية مفتوحة يدعم فترات طويلة وعبر أيام يتعامل مع البصمات المفقودة بسهولة عبر استعلامات لا يحتاج إلى حقول فارغة أو تتبع حالة السجل سلبيات: يحتاج إلى استعلامات قد تكون أكثر تعقيدا لحساب ساعات العمل قد ينتج عن البصمات المفقودة ساعات عمل غير منطقية إذا لم تعالج (لكن يمكن حلها بمهلة زمنية) تقييم: أفضل لأنه يدعم العملية المفتوحة بدون قيود ويتطلب معالجة أقل تعقيدا مقارنة بالخيار الأول

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

تحليل السلبيات وإمكانية التغلب عليها: غير مناسب لعملية مفتوحة حيث قد يسجل الموظف حضورا دون انصراف مؤقتا: السلبية: في جدول بحقول StartTime و EndTime إذا سجل الموظف حضورا يدخل StartTime ولم يسجل انصرافًا بعد، يبقى حقل EndTime فارغ مما يعقد التعامل مع السجلات غير المكتملة أثناء الحسابات وردا على: يمكن معالجة هذا بتصميم محكم: السماح بحقل EndTime بقيمة NULL مؤقتا مثلا مع معالجة السجلات غير المكتملة في الاستعلامات ( مثل استبعاد السجلات التي EndTime فيها NULL عند حساب ساعات العمل ) إضافة حقل حالة (Status) مثل "مفتوح" أو "مكتمل" لتتبع السجلات غير المكتملة التقييم: ممكن التغلب عليها بإضافة قواعد ومعالجات إضافية فعلا ولكن هذا يزيد من تعقيد النظام مقارنةً بالخيار الثاني (سجل واحد لكل بصمة) حيث لا يحتاج إلى تتبع الحالة أو معالجة القيم الفارغة صعوبة التعامل مع بصمات مفقودة (مثل نسيان انصراف): السلبية: إذا نسي الموظف تسجيل انصراف يبقى EndTime فارغ مما يؤثر على دقة حساب ساعات العمل ويتطلب تدخلا يدويا أو افتراضات (مثل تعيين وقت انصراف افتراضي) تصميم تقرير يحدد السجلات التي تحتوي على StartTime بدون EndTime لتسهيل التصحيح اليدوي إضافة آلية تلقائية( مثل تعيين EndTime افتراضي بعد مدة معينة مثل 8 ساعات مع تنبيه المستخدم ) التقييم: ممكن لكن يتطلب برمجة إضافية أو تدخل يدوي في المقابل: الخيار الثاني يتعامل مع البصمات المفقودة بشكل أسهل عبر الاستعلامات التي تحدد الحضور بدون انصراف بناء على التسلسل أقل مرونة إذا كثرت التسجيلات أو تغيرت متطلبات النظام: السلبية: هذا التصميم يفترض دائما أزواج حضور/انصراف إذا تغيرت المتطلبات (مثل إضافة نوع تسجيل جديد مثل "استراحة" أو دعم تسجيلات غير متتالية) يصبح التعديل معقد تصميم الجدول بحيث يدعم إضافة حقول جديدة أو أنواع تسجيلات إضافية (مثل إضافة حقل RecordType ) استخدام نموذج Access للتحكم في إدخال البيانات مما يسهل تعديل السلوك دون تغيير هيكل الجدول التقييم: ممكن جزئيا لكن إضافة أنواع تسجيلات جديدة قد تتطلب إعادة هيكلة الجدول أو الاستعلامات ولذلك يبقى الخيار الثاني أكثر مرونة لأنه يعتمد على سجلات مستقلة يمكن تخصيصها بسهولة يتطلب معالجة معقدة لضمان التسلسل الصحيح: السلبية: التأكد من أن كل StartTime يتبعه EndTime صحيح يتطلب قواعد تحقق أو برمجة لمنع إدخال بصمات غير متسلسلة (مثل تسجيل انصراف قبل حضور) استخدام نموذج Access يتحقق من آخر سجل قبل إدخال بصمة جديدة (مثل كود VBA للتحقق من وجود StartTime بدون EndTime ) إضافة قيد تحقق في الجدول لضمان أن EndTime يأتي بعد StartTime التقييم: ممكن لكن يتطلب برمجة إضافية أو قيود معقدة الخيار الثاني يبسط التسلسل لأن كل بصمة مستقلة ويتم تحديد الحضور/الانصراف بناء على ترتيب الوقت الخلاصة: كلام حضرتك صحيح: بتصميم محكم قد تتخطى هذه السلبية ولكن سوف يكون هناك ثمن مثل إضافة حقول حالة تقارير للسجلات غير المكتملة نماذج مع كود VBA وقيود تحقق و هذا يتطلب جهد إضافي في التصميم والبرمجة مما يزيد من تعقيد النظام وبالأخص كما أشرت عند محاولة إضافة أنواع تسجيلات جديدة في المستقبل لأي سبب مثل: "استراحة" أو "مأمورية عمل" أو دعم تسجيلات غير متتالية قد تتطلب إعادة هيكلة الجدول أو الاستعلامات لماذا الخيار الثاني لا يزال أفضل من وجهة نظرى المتواضعة ؟: البساطة: يعتمد على سجلات مستقلة مما يقلل الحاجة إلى معالجات إضافية للتسلسل أو السجلات غير المكتملة المرونة: يدعم التغييرات المستقبلية بسهولة (مثل إضافة أنواع تسجيلات جديدة) التعامل مع البصمات المفقودة: يحدد الحضور بدون انصراف باستعلامات بسيطة دون الحاجة إلى حقول إضافية

التحليل نظري لتصميم قاعدة البيانات الفكرة: طبيعة العملية: مفتوحة، بلا قيود زمنية أو يومية الموظف يسجل بصمات حضور وانصراف متعددة (حتى 10 مرات مثلا أو أكثر يوميا) وقد تمتد البصمة عبر أيام (مثل حضور 10 مساء وانصراف 6 صباحا) التسلسل: البصمة الأولى حضور التالية انصراف ثم حضور، وهكذا دون حقل يحدد نوع البصمة الضابط: دقيقة واحدة على الأقل بين كل بصمتين لتجنب الأخطاء المخرجات: حصر ساعات العمل (الفرق بين الحضور والانصراف) تحدي إضافي: إمكانية نسيان بصمة انصراف مما يتطلب التعامل مع سجلات غير مكتملة الخيارات لتصميم الجدول: الخيار الأول: جدول بحقول ( EmployeeID- StartTime- EndTime ) الوصف: كل سجل يحتوي على معرف الموظف - وقت الحضور - ووقت الانصراف الإيجابيات: تصميم مباشر لتسجيل أزواج الحضور/الانصراف يسهل حساب ساعات العمل ( EndTime – StartTime ) السلبيات: غير مناسب لعملية مفتوحة حيث قد يسجل الموظف حضورا دون انصراف مؤقتا صعوبة التعامل مع بصمات مفقودة (مثل نسيان انصراف) أقل مرونة إذا كثرت التسجيلات أو تغيرت متطلبات النظام يتطلب معالجة معقدة لضمان التسلسل الصحيح الخيار الثاني: جدول بحقول ( EmployeeID - RecordTime ) الوصف: كل بصمة تسجل كسجل مستقل بمعرف الموظف ووقت البصمة نوع البصمة (حضور/انصراف) يحدد بناء على التسلسل (زوجي=حضور - فردي=انصراف) الإيجابيات: مرن جدا، يناسب العملية المفتوحة دون قيود زمنية يدعم تسجيل بصمات متعددة يوميا أو عبر أيام يتعامل مع نسيان بصمة انصراف بسهولة عبر الاستعلامات تطبيق ضابط الدقيقة بسيط عبر قيود أو برمجة السلبيات: يتطلب استعلامات أكثر تعقيدا لربط الحضور بالانصراف وحساب ساعات العمل حجم الجدول قد يزداد بسبب تسجيل كل بصمة على حدة التوصية الخيار الثاني هو الأنسب للأسباب التالية: المرونة: يدعم طبيعة العملية المفتوحة وتعدد البصمات دون قيود التعامل مع الأخطاء: يسمح بتحديد ومعالجة البصمات المفقودة (مثل نسيان انصراف) عبر استعلامات البساطة: لا حاجة لحقل نوع التسجيل لأن التسلسل يحدد النوع تلقائيا حصر ساعات العمل: يمكن تحقيقه باستعلامات تربط البصمات المتتالية

أنت كمان بتضحك حظك لإنى مش فاضى لك بس نكاش بنكاش والبادى أنكش ... وأنت اللى بدأت بئه انا مش فاهم انا بقول ايه شكلى وصلت لاخر السكة خلاص التكة خلصت اتفضل يا سيدى ذاكر وانبسط بما انك عاوز وحده نمطية وتحكم من خلالها بس مش هخليها زيك تخفى العناصر وخلاص لا هخليــ .... وهأتكلم كتير ما تشوف بنفسك المرفق فيه الـ 3 نماذج بتوعك زى ما هم بينفذوا نفس طلباتك بس .......... فى نموذجين تانين ووحدتين نمطيتين شوف انت بقه اللى فيهم وذاكر ولما ابقى أروق لك ونفضى نبقى نتشاكس الموضوع والمرفق : >--->> من هنا يا أستاذ @Foksh طبعا بعيدا عن التهريج والهزار والمزاح لا اقلل من الاجابة الاولى وهى قطعا وبالفعل الأفضل على الإطلاق والإجابة المباشرة ولكن لأن فعلا كان فكرة كنت شغال عليها بالصدفة وتقريبا كانت شبه منتهيه فى ترتيب الأفكار بس فؤش أفندى بقه لعب فى نفوخى قلت لا بقه لازم أنهى الفكرة بالشكل الأمثل وعلشان مرتبطه بالموضوع ده وهو تنفيذ حدث فى وقت محدد أو بين وقتين محددين حبت اهز الورد وأضحك مع أخى الحبيب فؤش أفندى بمناسبة أن دى أول مشاركه لى معه بثوبه الجديد وليكون الموضوع مرجعا لمن يهتم لمثل هذه الأمور المجنونه شويه شويه هتخلونا نعمل كود يعمل اللى بنفكر ونحلم بيه ده اللى ناقص بقه وتبقى كملت مش تقولوا لى كود يعمل اكتر من وظيفه أو وظائف متتعده فى وقت محدد أو فى عدة أوقات مختلفة من إجراء واحد مركزى ايه لعب العيال ده يا فؤش أفندى هههه وأنا مصدقت لاقيته لعب عيال قلت العب براحتى بقه بقالى كتير ما أفوت وأول ما أفوت اشوفك ما شاء الله لابس البدله الحمرا

الوحده النمطية الأولى: bas01:TimeAction المميزات أنواع أحداث وتعليقات قابلة للتوسعة عبر Enum (EventType, ControlVisibility) تحديد توقيت إظهار/إخفاء عناصر النماذج بسهولة عبر الدالة SetControlVisibility تنفيذ إجراءات مؤقتة باستخدام CallTimeAction أو ApplyTimeActions منع التكرار التلقائي للتنفيذ بالدالة الذكية ExecuteDynamicMethod دعم المعاملات وتعددها في الدوال المنفذة (حتى 4 معاملات) تسجيل احترافي للأحداث عبر LogEvent في نافذة Immediate شرط تفعيل DebugMode الهدف : تنفيذ إجراءات مشروطة بالوقت مع إمكانية التنفيذ لمرة واحدة في الجلسة الاستخدام الأمثل :تحكم في ظهور عناصر/عدة عناصر بالنموذج أو تنفيذ إجراء/إجراءات بناء على الوقت اليومي استخدم الكود فى الحالات الآتيـــة : إذا كنت تحتاج إلى تنفيذ إجراءات زمنية عادية ومكررة يوميا إذا كنت لا تمانع في تنفيذ نفس الدالة مرات مختلفة إذا تغيّر التوقيت Option Compare Database Option Explicit ' ========================= ' إعدادات عامة ' ========================= Public DebugMode As Boolean Private dicExecuted As Object ' لتجنب تكرار التنفيذ ' ========================= ' أنواع الأحداث والمظهر ' ========================= Public Enum ControlVisibility visible = 0 Hidden = 1 ErrorState = 2 End Enum Public Enum EventType Information = 0 Warning = 1 [Error] = 2 End Enum ' ========================= ' تهيئة الوحدة ' ========================= Private Sub InitializeModule() If dicExecuted Is Nothing Then Set dicExecuted = CreateObject("Scripting.Dictionary") dicExecuted.CompareMode = vbTextCompare End If End Sub ' ========================= ' إعادة تعيين السجل ' ========================= Public Sub ResetExecutedLog() If Not dicExecuted Is Nothing Then dicExecuted.RemoveAll End Sub ' ========================= ' أدوات مساعدة عامة ' ========================= Public Sub LogEvent(message As String, Optional msgType As EventType = Information) If DebugMode Then Debug.Print Format(Now, "yyyy-mm-dd hh:nn:ss") & " [TimedAction] " & _ Choose(msgType + 1, "INFO", "WARN", "ERR") & ": " & message End If End Sub Private Function IsFormName(ByVal varValue As Variant) As Boolean On Error GoTo ErrHandler If VBA.TypeName(varValue) = "String" Then If SysCmd(acSysCmdGetObjectState, acForm, CStr(varValue)) = acObjStateOpen Then IsFormName = True End If End If Exit Function ErrHandler: IsFormName = False End Function Private Function IsString(v As Variant) As Boolean IsString = (VarType(v) = vbString) End Function Private Function IsBoolean(v As Variant) As Boolean IsBoolean = (VarType(v) = vbBoolean) End Function Private Function IsObject(v As Variant) As Boolean IsObject = (VarType(v) >= vbObject) End Function Public Function ShouldShowControl(Optional TargetTime As Date = #3:00:00 PM#) As Boolean ShouldShowControl = (Time() < TargetTime) End Function Public Function SetControlVisibility(frm As Form, ctlName As String, _ Optional TargetTime As Date = #3:00:00 PM#) As ControlVisibility On Error GoTo ErrorHandler If frm Is Nothing Or Len(Trim(ctlName)) = 0 Then LogEvent "النموذج أو اسم العنصر غير صالح في SetControlVisibility", [Error] SetControlVisibility = ErrorState Exit Function End If Dim ctl As Control Set ctl = frm.Controls(ctlName) If ctl Is Nothing Then LogEvent "العنصر '" & ctlName & "' غير موجود في النموذج", [Error] SetControlVisibility = ErrorState Exit Function End If Dim bolVisible As Boolean bolVisible = ShouldShowControl(TargetTime) ctl.visible = bolVisible SetControlVisibility = IIf(bolVisible, visible, Hidden) Exit Function ErrorHandler: LogEvent "خطأ في SetControlVisibility للعنصر '" & ctlName & "': " & Err.Description, [Error] SetControlVisibility = ErrorState End Function ' ========================= ' تنفيذ ذكي للدوال ' ========================= Private Sub ExecuteDynamicMethod(ByVal objTarget As Object, ByVal strMethodName As String, Optional arrArgs As Variant) On Error GoTo HandleError InitializeModule If Len(Trim(strMethodName)) = 0 Then LogEvent "اسم الدالة فارغ في ExecuteDynamicMethod", [Error] Exit Sub End If If dicExecuted.Exists(strMethodName) Then LogEvent "الدالة '" & strMethodName & "' تم تنفيذها مسبقاً", Warning Exit Sub End If If Not objTarget Is Nothing Then If IsMissing(arrArgs) Or IsEmpty(arrArgs) Then CallByName objTarget, strMethodName, VbMethod Else ExecuteWithParams objTarget, strMethodName, arrArgs End If Else If IsMissing(arrArgs) Or IsEmpty(arrArgs) Then Application.Run strMethodName Else ExecuteRunWithParams strMethodName, arrArgs End If End If dicExecuted(strMethodName) = True LogEvent "تم تنفيذ '" & strMethodName & "' بنجاح", Information Exit Sub HandleError: LogEvent "خطأ في تنفيذ '" & strMethodName & "': " & Err.Number & " - " & Err.Description, [Error] End Sub Private Sub ExecuteWithParams(objTarget As Object, strMethodName As String, params As Variant) On Error GoTo HandleError Dim paramCount As Long, i As Long Dim tempParams() As Variant If IsArray(params) Then paramCount = UBound(params) + 1 ReDim tempParams(paramCount - 1) For i = 0 To paramCount - 1 If IsFormName(params(i)) Then Set tempParams(i) = Forms(params(i)) Else tempParams(i) = params(i) End If LogEvent "معامل " & i & " لـ '" & strMethodName & "': " & CStr(tempParams(i)), Information Next Else paramCount = 1 ReDim tempParams(0) tempParams(0) = params LogEvent "معامل 0 لـ '" & strMethodName & "': " & CStr(tempParams(0)), Information End If Select Case paramCount Case 0: CallByName objTarget, strMethodName, VbMethod Case 1: CallByName objTarget, strMethodName, VbMethod, tempParams(0) Case 2: CallByName objTarget, strMethodName, VbMethod, tempParams(0), tempParams(1) Case 3: CallByName objTarget, strMethodName, VbMethod, tempParams(0), tempParams(1), tempParams(2) Case 4: CallByName objTarget, strMethodName, VbMethod, tempParams(0), tempParams(1), tempParams(2), tempParams(3) Case Else LogEvent "عدد المعاملات أكثر من 4 غير مدعوم في CallByName لـ '" & strMethodName & "'", [Error] End Select Exit Sub HandleError: LogEvent "خطأ في ExecuteWithParams لـ '" & strMethodName & "': " & Err.Description, [Error] End Sub Private Sub ExecuteRunWithParams(strMethodName As String, params As Variant) On Error GoTo HandleError Dim paramCount As Long, i As Long Dim tempParams() As Variant If IsArray(params) Then paramCount = UBound(params) + 1 ReDim tempParams(paramCount - 1) For i = 0 To paramCount - 1 If IsFormName(params(i)) Then Set tempParams(i) = Forms(params(i)) Else tempParams(i) = params(i) End If LogEvent "معامل " & i & " لـ '" & strMethodName & "': " & CStr(tempParams(i)), Information Next Else paramCount = 1 ReDim tempParams(0) tempParams(0) = params LogEvent "معامل 0 لـ '" & strMethodName & "': " & CStr(tempParams(0)), Information End If Select Case paramCount Case 0: Application.Run strMethodName Case 1: Application.Run strMethodName, tempParams(0) Case 2: Application.Run strMethodName, tempParams(0), tempParams(1) Case 3: Application.Run strMethodName, tempParams(0), tempParams(1), tempParams(2) Case 4: Application.Run strMethodName, tempParams(0), tempParams(1), tempParams(2), tempParams(3) Case Else LogEvent "عدد المعاملات أكثر من 4 غير مدعوم في Application.Run لـ '" & strMethodName & "'", [Error] End Select Exit Sub HandleError: LogEvent "خطأ في ExecuteRunWithParams لـ '" & strMethodName & "': " & Err.Description, [Error] End Sub ' ========================= ' التحقق من توقيت التنفيذ ' ========================= Private Function IsTimeMatch(ByVal dtmStart As Date, ByVal dtmEnd As Variant, ByVal bolUseRange As Boolean) As Boolean Dim dtmNow As Date: dtmNow = Time() If IsMissing(dtmEnd) Or IsNull(dtmEnd) Or Not bolUseRange Then IsTimeMatch = (dtmNow >= dtmStart) Else IsTimeMatch = (dtmNow >= dtmStart And dtmNow <= dtmEnd) End If End Function ' ========================= ' تنفيذ الإجراءات المؤقتة ' ========================= Public Sub CallTimeAction(ByVal objTarget As Object, ByVal strMethodName As String, _ ByVal dtmStart As Date, Optional ByVal dtmEnd As Variant, _ Optional ByVal bolUseRange As Boolean = True) On Error Resume Next If IsTimeMatch(dtmStart, dtmEnd, bolUseRange) Then ExecuteDynamicMethod objTarget, strMethodName End If End Sub Public Sub CallTimeActionWithArgs(ByVal objTarget As Object, ByVal strMethodName As String, _ ByVal arrArgs As Variant, ByVal dtmStart As Date, _ Optional ByVal dtmEnd As Variant, _ Optional ByVal bolUseRange As Boolean = True) On Error Resume Next If IsTimeMatch(dtmStart, dtmEnd, bolUseRange) Then ExecuteDynamicMethod objTarget, strMethodName, arrArgs End If End Sub Public Sub ApplyTimeActions(ByVal objTarget As Object, ByVal arrActions As Variant) InitializeModule Dim arrItem As Variant For Each arrItem In arrActions If Not IsArray(arrItem) Then LogEvent "العنصر في arrActions ليس مصفوفة صالحة", [Error] GoTo ContinueLoop End If Dim strMethod As String: strMethod = arrItem(0) Dim lngUB As Long: lngUB = UBound(arrItem) Dim arrArgs As Variant: arrArgs = Empty Dim dtmStart As Date Dim dtmEnd As Variant: dtmEnd = Null Dim bolUseRange As Boolean: bolUseRange = True If lngUB < 1 Then LogEvent "بيانات غير كافية للإجراء '" & strMethod & "'", [Error] GoTo ContinueLoop End If If IsArray(arrItem(1)) Then arrArgs = arrItem(1) dtmStart = arrItem(2) If lngUB >= 3 Then dtmEnd = arrItem(3) If lngUB >= 4 Then bolUseRange = arrItem(4) ' فحص المعاملات If strMethod = "HideControlByName" And UBound(arrArgs) >= 0 Then If Not IsString(arrArgs(0)) Then LogEvent "معامل HideControlByName ليس سلسلة نصية: " & CStr(arrArgs(0)), [Error] GoTo ContinueLoop End If ElseIf strMethod = "ComplexMsgBox" And UBound(arrArgs) >= 2 Then If Not IsString(arrArgs(0)) Or Not IsBoolean(arrArgs(1)) Or Not IsObject(arrArgs(2)) Then LogEvent "معاملات ComplexMsgBox غير صالحة: " & Join(arrArgs, ","), [Error] GoTo ContinueLoop End If ElseIf strMethod = "LocalMsg" And UBound(arrArgs) >= 1 Then If Not IsString(arrArgs(0)) Or Not IsString(arrArgs(1)) Then LogEvent "معاملات LocalMsg غير صالحة: " & Join(arrArgs, ","), [Error] GoTo ContinueLoop End If End If CallTimeActionWithArgs objTarget, strMethod, arrArgs, dtmStart, dtmEnd, bolUseRange Else dtmStart = arrItem(1) If lngUB >= 2 Then dtmEnd = arrItem(2) If lngUB >= 3 Then bolUseRange = arrItem(3) CallTimeAction objTarget, strMethod, dtmStart, dtmEnd, bolUseRange End If ContinueLoop: Next End Sub ' ========================= ' مثال استخدام ComplexMsgBox ' ========================= Public Sub ComplexMsgBox(ByVal strVal As String, ByVal bolFlag As Boolean, ByVal frm As Form) If bolFlag Then MsgBox "تم تنفيذ الإجراء على النموذج: " & frm.Name & " باستخدام القيمة: " & strVal End If End Sub -------------------------- الوحده النمطية الثانية : bas02:TimeExecutionKeyed المميزات تنفيذ ذكي مشروط بالوقت باستخدام TimedRunWithKey منع التكرار التام بفضل المفتاح الفريد (ExecutionKey) تعامل مرن مع الإجراءات بحد أقصى 4 معاملات بناء مفتاح فريد يجمع اسم الدالة والمعاملات والتوقيت الهدف : تنفيذ إجراءات مشروطة بالوقت وعدم تكرارها أبدا إذا تكررت المدخلات الاستخدام الأمثل : عندما تريد تنفيذ سيناريوهات متعددة و تحتاج لمنع تكرار تنفيذ نفس الإجراء بنفس المعلمات تماما استخدم الكود فى الحالات الآتيـــة : إذا كنت تريد ضمان عدم تكرار نفس الإجراء بنفس الظروف بشكل صارم (مثل تسجيل حركة مرة واحدة فقط لكل توقيت) إذا كنت تحتاج تتبع وتنفيذ ذكي مبني على مفتاح فريد Option Compare Database Option Explicit Private dicExecuted As Object ' ========== التهيئة ========== Private Sub InitializeModule() If dicExecuted Is Nothing Then Set dicExecuted = CreateObject("Scripting.Dictionary") dicExecuted.CompareMode = vbTextCompare End If End Sub Public Sub ResetExecutedLog() If Not dicExecuted Is Nothing Then dicExecuted.RemoveAll End Sub ' ========== أدوات مساعدة ========== Private Function ToSafeString(val As Variant) As String If IsObject(val) Then On Error Resume Next ToSafeString = TypeName(val) Exit Function End If If IsNull(val) Then ToSafeString = "<NULL>" Else ToSafeString = CStr(val) End If End Function Private Function BuildExecutionKey(ByVal strMethod As String, ByVal arrArgs As Variant, _ ByVal dtmStart As Date, ByVal dtmEnd As Variant) As String Dim arrParts() As String Dim i As Long ReDim arrParts(0) arrParts(0) = strMethod If IsArray(arrArgs) Then For i = 0 To UBound(arrArgs) ReDim Preserve arrParts(UBound(arrParts) + 1) arrParts(UBound(arrParts)) = ToSafeString(arrArgs(i)) Next ElseIf Not IsMissing(arrArgs) Then ReDim Preserve arrParts(UBound(arrParts) + 1) arrParts(UBound(arrParts)) = ToSafeString(arrArgs) End If ReDim Preserve arrParts(UBound(arrParts) + 1) arrParts(UBound(arrParts)) = Format(dtmStart, "hh:nn:ss") If Not IsMissing(dtmEnd) And Not IsNull(dtmEnd) Then ReDim Preserve arrParts(UBound(arrParts) + 1) arrParts(UBound(arrParts)) = Format(dtmEnd, "hh:nn:ss") End If BuildExecutionKey = Join(arrParts, "|") End Function Private Function AlreadyExecuted(strExecKey As String) As Boolean AlreadyExecuted = dicExecuted.Exists(strExecKey) End Function Private Sub MarkExecuted(strExecKey As String) dicExecuted(strExecKey) = True End Sub Private Sub Log(ByVal msg As String, Optional msgType As String = "INFO") If DebugMode Then Debug.Print Format(Now, "yyyy-mm-dd hh:nn:ss") & " [TimedActionKey] " & msgType & ": " & msg End Sub Private Function IsTimeMatch(ByVal dtmStart As Date, ByVal dtmEnd As Variant, ByVal bolUseRange As Boolean) As Boolean Dim dtmNow As Date: dtmNow = Time() If IsMissing(dtmEnd) Or IsNull(dtmEnd) Or Not bolUseRange Then IsTimeMatch = (dtmNow >= dtmStart) Else IsTimeMatch = (dtmNow >= dtmStart And dtmNow <= dtmEnd) End If End Function Private Sub RunWithArgs(ByVal objTarget As Object, ByVal strMethod As String, arrArgs As Variant) On Error GoTo HandleError If objTarget Is Nothing Then Select Case UBound(arrArgs) Case 0: Application.Run strMethod, arrArgs(0) Case 1: Application.Run strMethod, arrArgs(0), arrArgs(1) Case 2: Application.Run strMethod, arrArgs(0), arrArgs(1), arrArgs(2) Case 3: Application.Run strMethod, arrArgs(0), arrArgs(1), arrArgs(2), arrArgs(3) Case Else: Log "أكثر من 4 معاملات غير مدعومة لـ " & strMethod, "ERR" End Select Else Select Case UBound(arrArgs) Case 0: CallByName objTarget, strMethod, VbMethod, arrArgs(0) Case 1: CallByName objTarget, strMethod, VbMethod, arrArgs(0), arrArgs(1) Case 2: CallByName objTarget, strMethod, VbMethod, arrArgs(0), arrArgs(1), arrArgs(2) Case 3: CallByName objTarget, strMethod, VbMethod, arrArgs(0), arrArgs(1), arrArgs(2), arrArgs(3) Case Else: Log "أكثر من 4 معاملات غير مدعومة لـ " & strMethod, "ERR" End Select End If Exit Sub HandleError: Log "خطأ في تنفيذ " & strMethod & ": " & Err.Number & " - " & Err.Description, "ERR" End Sub ' ========== الدالة الرئيسية ========== Public Sub TimedRunWithKey(ByVal objTarget As Object, ByVal strMethod As String, _ ByVal arrArgs As Variant, ByVal dtmStart As Date, _ Optional ByVal dtmEnd As Variant, _ Optional ByVal bolUseRange As Boolean = True) InitializeModule If Not IsTimeMatch(dtmStart, dtmEnd, bolUseRange) Then Exit Sub Dim strKey As String strKey = BuildExecutionKey(strMethod, arrArgs, dtmStart, dtmEnd) If AlreadyExecuted(strKey) Then Log "تخطي التنفيذ المكرر لـ " & strMethod, "WARN" Exit Sub End If RunWithArgs objTarget, strMethod, arrArgs MarkExecuted strKey Log "تم التنفيذ بـ Key: " & strKey End Sub ' For Tesr Public Sub TestMsgProc(ByVal strMsg As String, ByVal bolShow As Boolean) If bolShow Then MsgBox "تم التنفيذ: " & strMsg, vbInformation, "اختبار" Else Debug.Print "? تم تجاهل الإظهار ولكن التنفيذ تم: " & strMsg End If End Sub وأخيرا المرفق TimedAction.accdb