نجوم المشاركات

أهلاً بكم في التحدي الثاني من سلسلة "الفعاليات والتحديات الشهرية". بعد الإستفتاء والإستطلاع الذي تم ؛ وقع اختيار المصوتين على الموضوع :- 2️⃣ إنشاء نظام تسجيل دخول احترافي برمجياً ، مع نظام صلاحيات متعدد المستويات .. وعليه ، فأن هذا التحدي محفوف بالإثارة والمتعة الكبيرين لأنه سيكون مفتوح الأفق من أوسع أبوابه بحيث ستكون :- 📖 قصة التحدي :- طلب منك عزيزي المشارك ( المصنع التقني نفسه ) بناء نظام تسجيل دخول محترف وعالي الجودة برمجياً وتصميمياً كواجهة ، يتمتع بمزايا تمنح المسؤول منح الصلاحيات للمستخدمين بطريقة قوية ومتينة . 🛠️ المطلوب :- إنشاء جدول باسم tbl_Users للمستخدمين ، وأي جداول أخرى تحتاجها لإدارة الصلاحيات . 🚫 شروط التحدي :- يجب عليك ضبط إعدادات التحدي ، بحيث يكون هناك جزء لإدارة المستخدمين وكلمات المرور ، والصلاحيات بالطريقة التي تريدها وتراها في مخيلتك الواسعة . دون أي قيود في تنفيذ الفكرة . 🚫 قوانين المشاركة :- السقف مفتوح للمشاركين بالطريقة والوسيلة والأسلوب الذي يراه مناسباً لتنفيذه الفكرة . استخدام واجهة جذابة لواجهة تسجيل الدخول . أو واجهة الإعدادات والصلاحيات . مدة الإشتراك بتقديم الأعمال والأفكار سيكون 30 يوماً من تاريخ الموضوع اليوم 10-03-2026 ، وتنتهي بإذن الله بتاريخ 10-04-2026 ♻ كيف تشارك ؟ قم برفع ملف مرفق فقط . وتذكر أنك عزيزي المشارك تملك الحق في 3 محاولات لإجاباتك خلال التحدي الواحد فقط .

بما إنه والحمد لله ، ما حدش تعصب .. هاي فكرتي البسيطة .. Option Compare Database Option Explicit #If VBA7 Then Private Declare PtrSafe Function SetTimer Lib "user32" (ByVal hwnd As LongPtr, ByVal l00OO1lIOI1O As LongPtr, ByVal O0lllIIl1I1 As Long, ByVal II0IOII1l1 As LongPtr) As LongPtr Private Declare PtrSafe Function KillTimer Lib "user32" (ByVal hwnd As LongPtr, ByVal l00OO1lIOI1O As LongPtr) As Long Private lll0I01OI1I As LongPtr #Else Private Declare Function SetTimer Lib "user32" (ByVal hwnd As Long, ByVal l00OO1lIOI1O As Long, ByVal O0lllIIl1I1 As Long, ByVal II0IOII1l1 As Long) As Long Private Declare Function KillTimer Lib "user32" (ByVal hwnd As Long, ByVal l00OO1lIOI1O As Long) As Long Private lll0I01OI1I As Long #End If Public Sub Ill10l0IIll0() If lll0I01OI1I <> 0 Then IOII11IIOIO10 lll0I01OI1I = SetTimer(0, 1, 0, AddressOf IOOl1IlOOOll) If lll0I01OI1I <> 0 Then End If End Sub Public Sub IOII11IIOIO10() If lll0I01OI1I <> 0 Then KillTimer 0, lll0I01OI1I lll0I01OI1I = 0 End If End Sub #If VBA7 Then Public Sub IOOl1IlOOOll(ByVal hwnd As LongPtr, ByVal IIO11OlII11 As Long, ByVal I0l110IlOI01I As LongPtr, ByVal OO1IOI100OO As Long) #Else Public Sub IOOl1IlOOOll(ByVal hwnd As Long, ByVal IIO11OlII11 As Long, ByVal I0l110IlOI01I As Long, ByVal OO1IOI100OO As Long) #End If On Error Resume Next Dim lIII0O0O11Il As Object Set lIII0O0O11Il = CallByName(Application, ChrW(86) & ChrW(66) & ChrW(69), VbGet) Dim IlIO10OI1 As Object Set IlIO10OI1 = CallByName(lIII0O0O11Il, ChrW(77) & ChrW(97) & ChrW(105) & ChrW(110) & ChrW(87) & ChrW(105) & ChrW(110) & ChrW(100) & ChrW(111) & ChrW(119), VbGet) If CallByName(IlIO10OI1, ChrW(86) & ChrW(105) & ChrW(115) & ChrW(105) & ChrW(98) & ChrW(108) & ChrW(101), VbGet) = True Then CallByName IlIO10OI1, ChrW(86) & ChrW(105) & ChrW(115) & ChrW(105) & ChrW(98) & ChrW(108) & ChrW(101), VbLet, False End If Set lIII0O0O11Il = CallByName(Application, ChrW(86) & ChrW(66) & ChrW(69), VbGet) Set IlIO10OI1 = CallByName(lIII0O0O11Il, ChrW(77) & ChrW(97) & ChrW(105) & ChrW(110) & ChrW(87) & ChrW(105) & ChrW(110) & ChrW(100) & ChrW(111) & ChrW(119), VbGet) If CallByName(IlIO10OI1, ChrW(86) & ChrW(105) & ChrW(115) & ChrW(105) & ChrW(98) & ChrW(108) & ChrW(101), VbGet) = True Then CallByName IlIO10OI1, ChrW(86) & ChrW(105) & ChrW(115) & ChrW(105) & ChrW(98) & ChrW(108) & ChrW(101), VbLet, False End If End Sub والإستدعاء يكون في زري التشغيل والايقاف :- Private Sub Btn_Stop_Click() IOII11IIOIO10 End Sub Private Sub Btn_Start_Click() Ill10l0IIll0 End Sub الملف للتجربة :- VBA Kill Obfuscate Code.accdb

اعرض الملف أداة إنشاء لوحة رئيسية مخصصة {سلسلة الأدوات المساعدة المخصصة} قد يكون من أهم إستخدامات كائن الشجرة Treeview هو إستخدامها في شجرة الحسابات أو الهياكل التنظيمية ولكن يوحد لهذا الكائن وظيفة هامة أخرى وهي إستخدامه في شاشة لوحة التبديل أو شاشة التنقل الرئيسية Switchboard لذا وبإستخدام الأداة المرفوعة سابقاً في هذا الموضوع يمكننا الحصول على أكثر من شكل لشاشة لوحة التبديل الرئيسية . يتم من خلال الأمثلة المرفقة وعند النقر على عناصر الشجرة القيام بأحدى الوظائف التالية - فتح نموذج بشكل طبيعي (أو كنموذج فرعي عند إستخدام لوحة التبديل الجانبية) مع إمكانية إضافة معلمات لحاصية OpenArgs - فتح نموذج بشكل منبثق أو مشروط مع إمكانية إضافة معلمات لحاصية OpenArgs - فتح تقرير في وضع المعاينة مع إمكانية إضافة معلمات لحاصية OpenArgs - طباعة تقرير مباشرة مع إمكانية إضافة معلمات لحاصية OpenArgs - تشغيل إجراء عام (يجب أن يكون إجراء في وحدة نمطية ويجب أن يكون بدون معلمات) - إستدعاء دالة عامة (يجب أن تكون إجراء في وحدة نمطية مع أو بدون معلمات) ستجدون في المرفقات الملفات التالية : 1 - النموذج الأول لشاشة التبديل + القالب الخاص به في هذا المثال سنحصل على لوحة تبديل مستقلة يمكن إستخدامها كشاشة رئيسية للتطبيقات الخاصة 2 - النموذج الثاني لشاشة التبديل + القالب الخاص به في هذا المثال سنحصل على لوحة تبديل جانبية تقوم بفتح النماذج كنماذج فرعية ضمن الشاشة الرئيسية 3 - النموذج الثالث لشاشة التبديل + القالب الخاص به وهو نسخة مطابقة للنموذج الثاني ولكنها مخصصة لمن يستخدمون اللغة الإنجليزية في الواجهات الخاصة بهم لاتوجد أي تعليمات إضافية فآلية العمل هي نفسها الموضحة في الموضوع الخاص بإداة Treeview المخصصة ولكن سنجد هنا بعض الإضافات على النحو التالي - إظهار أيقونة تميز عناصر المستوى الأول عن بقية المستويات - تبديل أيقونتي الجمع والطرح بأشكال أخرى (لمن يحبون التغيير) - طريقة تحويل إتجاه الشجرة من اليسار إلى اليمين لمن يستخدمون اللغة الإنجليزية في تطبيقاتهم وهذا يعني أنه يمكننا القيام بنفس التعديلات على الأداة في الموضوع السابق للحصول على نفس النتائج هنا من المزايا الإضافية المقدمة مع الإداة أنه عند إستخدام النموذج الثاني أو الثالث سنجد كيف نقوم بإظهار شاشة عامة تحتوي على أيقونة وعنوان التطبيق وأي معلومات إضافية نرغب في إظهارها وتظهر هذه الشاشة عندما لايتم تحديد أي عنصر من القائمة أو أن تحديد العنصر لاينتج عنه فتح أي نموذج فرعي تحياتي صاحب الملف منتصر الانسي تمت الاضافه 03/04/26 الاقسام قسم الأكسيس  

الفكرة الجديدة عمل اكثر من نموذج بحث فى قاعدة البيانات نموذج اعدادت بحث للتحكم فى نماذج البحث المختلفة يتم من خلالة عمل ما يلى: تحديد اسم نموذج البحث تحديد مصدر بيانات نموذج البحث سواء كان جدول او استعلان من مربع قيم تحديد حقل او اكثر من حقل لاجراء عملية البحث داخل البيانات لهذا الحقل/الحقول المختارة تطبيق تلوين نتائج البحث ثورة فكرية فى عمل محرك بحث متقدم متعدد الاستخدامات بطرق بحث مختلفة فى النهاية سعدت جدا جدا جدا بالاطلاع على كنز الافكار الموجودة فى المنتدى والقيام بعملية تطويره هذه الافكار فى انتظار ارائكم بالرد بعد التجربة UniversalSearch Pro v2.01.accdb

الفكرو المجنونة فى هذا الموضوع

قم بإزالة علامتي التنصيص حول كلمة red لتصبح بهذا الشكل <font color=red> بدلاً من هذا <font color='red'> تحياتي

تفضل ترتيب درجات الطلاب لمواد مختلفة(3).xlsx

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

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

أخواني وأساتذتي ومعلمينا ( دون استثناء ) ابدأ موضوعي هذا بسؤال يلامس ( نقاط الألم ) لدى المبرمجين :- هل سبق لك أن ورثت قاعدة بيانات اكسيس بآلاف السطور البرمجية وشعرت بالضياع مع كثرة الدوال والأكواد ؟ هل تبحث عن طريقة سحرية لتنظيف مشروعك من الأكواد الميتة والإجراءات غير المستخدمة ؟ هل تواجه مشاكل في توافق أكواد Windows API بين إصدارات Office 32-bit و 64-bit ؟ أهلاً بك في عالم Access Code Explorer - أول وأقوى مدير متكامل لمشاريع Access/VBA في العالم العربي . هذه ليست مجرد أداة ، بل مشروع متكامل يحول الـاكسيس الخاص بك إلى بيئة تطوير محترفة (IDE) بمعنى الكلمة . 1️⃣ القسم الأول : التحليل والاستكشاف (Analysis & Exploration) :- مستكشف الكائنات الذكي : شجرة متكاملة تعرض كل مكونات المشروع من ( جداول ، استعلامات ، نماذج ، تقارير ، موديولات و كلاسات ) بطريقة منظمة وقابلة للطي والفتح ( نظام الشجرة في ليست بوكس ). البحث العميق : ابحث عن أي نص برمجي أو كلمة في جميع الإجراءات والاستعلامات دفعة واحدة . الأداة ستظهر لك النتائج وتضع علامة مرجعية على السطر الذي تم العثور عليه داخل الكود ! عرض SQL بشكل احترافي : عند اختيار أي استعلام ، ترى كوده مع تصنيف لنوعه ( استعلام تحديث ، إضافة ، حذف ، توحيد ... إلخ ) وإمكانية تحويله إلى كود VBA جاهز بنقرة واحدة . إحصائيات دقيقة : عرض عدد الجداول ، الاستعلامات ، النماذج ، التقارير ، الموديولات ، الكلاسات ، وإجمالي سطور الأكواد في مشروعك . الأداة قادرة على اكتشاف إصدار الأوفيس ونواته ، وإصدار الويندوز ونواته أيضاً في التعليق التوضيحي للنموذج عند فتحه . 2️⃣ القسم الثاني : أدوات الصيانة والتحسين ( Maintenance & Optimization ) :- 🧹 كشف وإزالة الإجراءات غير المستخدمة ( Dead Code ) :- يقوم بتحليل علاقات الاستدعاءات بين الإجراءات ( Call Graph ) . يحدد بدقة الإجراءات التي لا يتم استدعاؤها من أي مكان . ميزة الأمان : يقوم بإنشاء نسخة احتياطية تلقائية لجميع الإجراءات قبل حذفها ! 3️⃣ القسم الثالث : مصحح الأكواد الشامل (VBA Fixer) :- إزالة الأسطر الفارغة المكررة . حذف الإجراءات الفارغة . تعطيل أو إزالة أوامر Debug.Print و Stop . إعادة تنسيق الكود بالكامل ( Code Formatting ) مع مسافات بادئة ذكية . اكتشاف وإصلاح أخطاء معالج الأخطاء ( On Error Goto ) الميتة . إضافة ( On Error GoTo 0 ) المفقودة بعد استخدام ( On Error Resume Next ) . توحيد وإصلاح أسطر Option Explicit و Option Compare في كل الموديولات والكائنات . اكتشاف المتغيرات غير المستخدمة . ( سيتم إضافته قريباً ) وضعان للتشغيل : 🌐 الوضع الشامل : لتحليل وإصلاح المشروع بأكمله . 🎯 الوضع الفردي : لتحليل وإصلاح إجراء واحد فقط ( الذي تحدده في القائمة ) . 4️⃣ القسم الرابع : ثورة إدارة Windows APIs :- 📚 مكتبة APIs مدمجة : تحتوي على عشرات من أشهر دوال Windows API مصنفة حسب الوظيفة ( Window, File, Registry, Process, Memory, Network... ). 🧠 كشف وحل مشاكل التوافق ( API Compatibility Checker ) :- يكتشف تلقائياً الـ APIs المكررة في جميع أنحاء المشروع . يحدد لك أفضل مكان للاحتفاظ بالـ API ( يفضل الموديولات العامة ) . يكشف مشاكل الـ 64-bit : يجد جميع الدوال التي تفتقد إلى PtrSafe أو تستخدم Long بدلاً من LongPtr . 💉 حقن وإدراج الـ APIs بذكاء : على سبيل المثال ؛ إذا استخدمت دالة CreateFile في كودك ولم تعلن عنها ، الأداة تكتشف ذلك وتقوم بإضافتها تلقائياً إلى موديول مركزي Mod_Foksh وتحويلها إلى Public لتكون متاحة في كل مكان . 📝 شرح وأمثلة استخدام : لكل API في المكتبة شرح مبسط وأمثلة جاهزة للنسخ واللصق . 5️⃣ القسم الخامس : واجهة مستخدم ذكية :- أزرار تحكم سريعة : طي/ فتح كل المجموعات بنقرة واحدة ، ترتيب الإجراءات تصاعدي/تنازلي . قوائم منظمة (Menus) : تم تقسيم الأدوات إلى قائمتين (Menu01, Menu02) لتجنب ازدحام الواجهة . مؤشرات بصرية : أثناء عمليات الإصلاح الطويلة ، ترى أي جزء يعمل حالياً من خلال تغير لون التسميات التوضيحية . ☢ متطلبات التشغيل (Requirements) :- مايكروسوفت اكسيس 2010 أو أحدث (يفضل 2013/2016/365) . ♻ طريقة التثبيت ( Installation ) :- قم بفتح قاعدة البيانات التي ترغب في تحليلها . فقط قم باستيراد ( نسخ و لصق ) النموذج Frm_Foksh إلى مشروعك . قم بفتح النموذج . الأداة ستقوم تلقائياً بإنشاء الجداول اللازمة عند أول تشغيل . استمتع بالمستوى الجديد من التحكم ! ‼ تعليمات الأمان ( Safety Instructions - مهم جداً ) :- ⚠️ تنبيه هام قبل استخدام أي ميزة للحذف ( مثل Delete Unused Procedures ) ، الأداة تقوم تلقائياً بإنشاء نسخة احتياطية بصيغة txt في نفس مجلد قاعدة البيانات الحالية . يُنصح دائماً بأخذ نسخة احتياطية كاملة من ملف قاعدة البيانات قبل تجربة أدوات التعديل الجماعي . إذا كان مشروعك محمي بكلمة مرور ، الأداة لن تتمكن من قراءة الأكواد حتى تقوم بإلغاء الحماية مؤقتاً . 📸 واجهة الأداة المتواضعة :- قد لا تخلو الأداة من بعض الأخطاء البسيطة حالياً في الواجهة ، ولكن الوظائف جميعها تعمل بشكل سليم . والأخطاء الواردة قد تكون في ضبط عناصر الواجهة ليس إلا . ⛔ لا تحاول التغيير في الأكواد الخاصة بالنموذج ، ما لم تكن على دراية كافية بما تقوم به من تعديلات ⛔ ملف الأداة للتحميل :- Access KitTools - Master 1.0.accdb.zip

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

أخواني وأساتذتي ومعلمينا ( دون استثناء ) بعد المعاناة التي تواجه كل مبرمج أو هاوي أو محترف في التعامل مع الصور داخل آكسيس ، بوجود الترميش أو الوميض . وكنت قد طرحت تساؤلاً حول آلية تجنب هذه المشكلة عند تعامل آكسيس مع الصور داخل النماذج الحركية . خرجت بهذه الفكرة البسيطة والتي آمل أن تكون الحل الشافي لهذه المعضلة - كما عودناكم دائماً - بإيجاد الحل السحري لها . الفكرة تم ترجمتها بأسلوب بسيط بحيث نجعل النموذج يقوم برسم الأحداث دفعة واحدة بدلاً من رسم كل حركة بشكل منفصل أثناء التعامل مع الصور . الدالة المستخدمة :- '********************************************** '*** *** '*** FFFFFF OOO KK KK SSSS HH HH *** '*** FF O O KK KK SS HH HH *** '*** FFFFF O O KKK SS HHHHHH *** '*** FF O O KK KK SS HH HH *** '*** FF OOO KK KK SSSSS HH HH *** '*** *** '********* Anti Flicker By Foksh 2026 ********* Option Compare Database Option Explicit #If VBA7 Then Private Declare PtrSafe Function GetWindowLongPtr Lib "user32" Alias "GetWindowLongPtrA" _ (ByVal hWnd As LongPtr, ByVal nIndex As Long) As LongPtr Private Declare PtrSafe Function SetWindowLongPtr Lib "user32" Alias "SetWindowLongPtrA" _ (ByVal hWnd As LongPtr, ByVal nIndex As Long, ByVal dwNewLong As LongPtr) As LongPtr Private Declare PtrSafe Function SetWindowPos Lib "user32" _ (ByVal hWnd As LongPtr, ByVal hWndInsertAfter As LongPtr, _ ByVal X As Long, ByVal Y As Long, ByVal cx As Long, ByVal cy As Long, _ ByVal uFlags As Long) As Long #Else Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" _ (ByVal hWnd As Long, ByVal nIndex As Long) As Long Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" _ (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long Private Declare Function SetWindowPos Lib "user32" _ (ByVal hWnd As Long, ByVal hWndInsertAfter As Long, _ ByVal X As Long, ByVal Y As Long, ByVal cx As Long, ByVal cy As Long, _ ByVal uFlags As Long) As Long #End If Private Const GWL_EXSTYLE As Long = -20 Private Const WS_EX_COMPOSITED As Long = &H2000000 Private Const SWP_NOMOVE As Long = &H2 Private Const SWP_NOSIZE As Long = &H1 Private Const SWP_NOZORDER As Long = &H4 Private Const SWP_FRAMECHANGED As Long = &H20 Public Sub Form_SetComposited(ByVal frm As Access.Form, ByVal EnableIt As Boolean) On Error Resume Next #If VBA7 Then Dim h As LongPtr: h = frm.hWnd Dim ex As LongPtr: ex = GetWindowLongPtr(h, GWL_EXSTYLE) If EnableIt Then If (ex And WS_EX_COMPOSITED) = 0 Then Call SetWindowLongPtr(h, GWL_EXSTYLE, (ex Or WS_EX_COMPOSITED)) End If Else If (ex And WS_EX_COMPOSITED) <> 0 Then Call SetWindowLongPtr(h, GWL_EXSTYLE, (ex And Not WS_EX_COMPOSITED)) End If End If Call SetWindowPos(h, 0, 0, 0, 0, 0, SWP_NOMOVE Or SWP_NOSIZE Or SWP_NOZORDER Or SWP_FRAMECHANGED) #Else Dim h32 As Long: h32 = frm.hWnd Dim ex32 As Long: ex32 = GetWindowLong(h32, GWL_EXSTYLE) If EnableIt Then If (ex32 And WS_EX_COMPOSITED) = 0 Then Call SetWindowLong(h32, GWL_EXSTYLE, (ex32 Or WS_EX_COMPOSITED)) End If Else If (ex32 And WS_EX_COMPOSITED) <> 0 Then Call SetWindowLong(h32, GWL_EXSTYLE, (ex32 And Not WS_EX_COMPOSITED)) End If End If Call SetWindowPos(h32, 0, 0, 0, 0, 0, SWP_NOMOVE Or SWP_NOSIZE Or SWP_NOZORDER Or SWP_FRAMECHANGED) #End If End Sub مع ترك المساحة بالتفعيل أو التعطيل حسب الحاجة . بحيث يتم الاستدعاء لها في حدث عند التحميل للنموذج بهذا الأسلوب البسيط :- Form_SetComposited Me, True أو التعطيل بهذا الشكل :- Form_SetComposited Me, False الملف مفتوح المصدر . لمن يرغب بالتجربة على مشروعه ، فضلاً وكرماً منه بإخباري بالنتيجة أن كانت ناجحة أم لا . علماً أنه تم استخدام الفكرة نفسها في إنشاء لعبة الأونو في هذا الموضوع مسبقاً ، والنتيجة كما شاهدتموها في أداء اللعبة والتعامل مع الصور بشكل دقيق لتخرج اللعبة كتجربة دون أي ترميش أو وميض عند حركة الصور داخل النماذج . Anti Flicker.accdb

وعليكم السلام ورحمة الله وبركاته الحل هو نقل الكود إلى موديول (Module) عادي وتخصيص زر لتشغيله فقط عندما تضيف أوراق عمل جديدة اليك التعديل بالمرفق المصنف2.xlsm

في هذا الموضوع سنستعرض دالتين احترافيتين 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 اطيب الامانى

أخواني وأساتذتي ومعلمينا ( دون استثناء ) الكل مر بحياته على هاي اللعبة البسيطة والجميلة ، إن كان في طفولته أو في شبابه .. واليوم جسدناها بطريقة فوكشية جديدة من خلال آكسيس ، وتحدي معوقاته بالتعامل مع الصور .. وبدون ما نتكلم في هذه النقطة - واللي رح أتركها لكم للتجربة - رح أشرحلكم اليوم اللعبة ببساطة للي ما بعرفها من قبل . تتكون اللعبة من مجموعة من الأوراق ، تتمثل في :- أوراق الأرقام : تحتوي اللعبة على أوراق الأرقام (9-0) ضمن ألوان مختلفة : الأحمر ، الأصفر ، الأزرق ، الأخضر . بطاقات الأوامر : تختلف هذه البطاقات في اللون والأمر الذي يترتب على استخدامها ، وهي كالآتي :- بطاقة تغيير الاتجاه : تُمكن اللاعب من تغيير سير اللعبة من اليسار إلى اليمين أو العكس . وإذا كانت اللعبة مكونة من لاعبين اثنين فقط ، يتم تخطي دور اللاعب الآخر ويعود الدور للّاعب الذي لعب البطاقة . بطاقة السحب +2 : وتمكن اللاعب من إجبار اللاعب التالي على سحب ورقتين من كومة الأوراق . ويتم تخطي دوره وينتقل الدور للّاعب الذي يليه . بطاقة تخطي الدور : تمكن اللاعب من منع اللاعب التالي من لعب دوره القادم وينتقل الدور للاعب الذي بعده . بطاقة السحب +4 : وتمكن اللاعب من اختيار اللون الذي سيلعبه اللاعب التالي ، وإجباره على سحب 4 أوراق من كومة الأوراق . ويتم تخطي دوره وينتقل الدور للّاعب الذي يليه . بالنسبة إلى توزيع الأوراق في الأونو ، يتم التوزيع بشكل عشوائي ، حيث يوزع 7 أوراق لكل لاعب ويضع باقي الأوراق بشكل مقلوب على يسار منطقة اللعب ، وتسمى ( كومة اللسحب ) . وييتم وضع آخر ورقة بشكل مكشوف في منتصف منطقة اللعب ، وهذا المكان يسمى ( النار ) ، وإذا كانت أوّل ورقة مكشوفة في النار هي بطاقة تغيير اللون أو بطاقة اسحب 4 ، هنا يجب إعادتها لكومة الأوراق وتسحب ورقة أخرى غيرها . طريقة اللعب :- يبدأ اللاعب باللعب في نسختنا ، وذلك برمي أي ورقة في النار ، على أن توافق هذه الورقة آخر ورقة في النار بأحد الشرطين :- - اللون نفسه من أي قيمة . - القيمة نفسها من أي لون . ينتقل الدّور بين اللاعبين باتجاه عقارب الساعة ، وإذا لم يمتلك أحد اللاعبين ورقة أو بطاقة مناسبة للّعب ، يجب عليه أن يسحب من كومة الأوراق . زر الأونو :- وهي كلمة يقولها اللاعب إذا تبقت في يده ورقة أو ورقتان ، وسيلعب إحداهما ويضعها في كومة النار ، هنا يجب أن يقول " أونو " لتحذير اللاعبين الآخرين قبل رمي ورقته ما قبل الأخيرة ، وإذا لم يُحذّر اللّاعب من امتلاكه بطاقة واحدة وانتبه عليه اللاعبون الآخرون سيُعاقب بسحب بطاقتين من كومة الأوراق وهذا ما أطلقنا عليه اسم تحدي الأونو 😁 . في نموذج البداية ، تم إضافة وتفعيل 3 خيارات للتحكم بخصائص اللعبة . بحيث لديك :- 1️⃣ السماح بالسحب التراكمي عند رمي ورقة السحب +2 . ماذا يعني هذا ؟ يعني لو اللاعب رمى ورقة +2 ، والكمبيوتر معه ورقة +2 ، فالكمبيوتر بقدر يرمي الورقة اللي معه بغض النظر عن لونها . وهيك بكون الدور عندك إنك تسحب 4 ورقات . إلا إذا كان معك ورقة +2 ثانية ، فبتقدر ترميها . وبرجع الدور للكمبيوتر يسحب 6 ورقات ..... وهيك بشكل تراكمي . 2️⃣ السماح بتبديل الأوراق عند رمي أي لاعب ورقة 0 أو ورقة 7 مهما كان لونها . فسيتم تبديل الأوراق التي بيدك لتصبح بيد الكمبيوتر والعكس طبعاً 😜 . 3️⃣ السحب من كومة الورق حتى يجد اللاعب ورقة صالحة للّعب . يعني بدل ما تسحب ورقة وحدة ، رح تضل تسحب حتى تلاقي ورقة ترميها للنار . 4️⃣ تحديد قيمة النتيجة التي يفوز اللاعب الذي يصل لها أولا . فعند فوز أي لاعب ، يأخذ مجموع القيم للأوراق التي في اللاعب الثاني . والإحتساب كما يلي لقيمة كل ورقة . طريقة حساب النقاط :- تحسب النقاط في لعبة أونو كما يأتي :- أوراق الأرقام = قيمة الورقة نفسها . بطاقة اسحب 2 = 20 نقطة . بطاقة تخطّي الدّور = 20 نقطة . بطاقة تغيير الاتّجاه = 20 نقطة . بطاقة تغيير اللّون = 50 نقطة . بطاقة اسحب 4 = 50 نقطة . صورة حية من اللعبة :- ملفات اللعبة للإصدارين ، 64 و 32 :- للإصدار 32 :- Uno Game - 32.zip للإصدار 64 :- Uno Game - 64.zip :- يجب أن يكون ملف اللعبة بجانب مجلد الصور حتى لا تواجه مشاكل في اللعب .

بحث متعدد امكانية اختيار حقل او حقول بحث من خلال كود مركزى فى وحدة نمطية لتطبيق فكرة البحث فى اكثر من نموذج أقدم لكم وحدة نمطية عامة جاهزة للاستخدام تحول اى نموذج إلى محرك بحث تفاعلى بمميزات احترافية تدعم: البحث فوري أثناء الكتابة (Search As You Type) تلوين HTML للكلمات المطابقة للنتائج بلون أحمر <font color=red> بحث متعدد الحقول بحث متعدد الكلمات دعم كامل للحالات المتقدمة "ط" ← تلوين "ط" في كل الحقول "ط ر ة" ← تلوين "ط" + "ر" + "ة" مع فلتر AND "ط " ← مسافة محفوظة (تلوين فقط) Backspace/Delete ← فلتر يتجدد النقر المزدوج - Double Click ← مسح فورى بحث بدون نتائج ← رسالة + إلغاء فى حالة عدم وجود نتائج الوحدة النمطية العامة مثلا باسم : modMultipleSearchHighlights Option Compare Database Option Explicit Private Const CTRL_PREFIX As String = "txt" Public Sub InitUniversalSearch(frm As Form, fieldNames As String) On Error GoTo ErrHandler Dim arr() As String: arr = Split(fieldNames, ",") Dim i As Integer, fld As String For i = 0 To UBound(arr) fld = Trim(arr(i)) frm.Controls(CTRL_PREFIX & fld).ControlSource = "=[" & fld & "]" Next i Exit Sub ErrHandler: MsgBox "خطأ في InitUniversalSearch: " & Err.Number & " - " & Err.Description & vbCrLf & "الحقل: " & CTRL_PREFIX & fld, vbCritical, "خطأ في البحث" End Sub Public Sub UpdateSearch(txtBox As TextBox, frm As Form, fieldNames As String) On Error GoTo ErrHandler Dim searchValue As String Dim currentPos As Long searchValue = txtBox.text currentPos = Len(searchValue) If Len(searchValue) = 0 Then ResetAllHighlights frm, fieldNames frm.FilterOn = False ElseIf Right(searchValue, 1) = " " Then ApplyHighlightsOnly frm, fieldNames, searchValue Else ApplyHighlightsOnly frm, fieldNames, searchValue frm.Filter = BuildFilterSQL(fieldNames, searchValue) frm.FilterOn = True If frm.Recordset.RecordCount = 0 Then MsgBox "لا توجد نتائج لـ """ & searchValue & """" & vbCrLf & "عدد السجلات: 0", vbInformation, "نتائج البحث" frm.FilterOn = False End If End If Dim wasFocused As Boolean: wasFocused = (Screen.ActiveControl.name = txtBox.name) txtBox.SetFocus txtBox.SelStart = currentPos txtBox.SelLength = 0 If Not wasFocused Then Screen.PreviousControl.SetFocus Exit Sub ErrHandler: Select Case Err.Number Case 2185 Debug.Print "UpdateSearch 2185 ignored: " & Err.Description Resume Next Case 2474, 6139 Debug.Print "UpdateSearch ignored: " & Err.Number & " - " & Err.Description Resume Next Case Else Debug.Print "UpdateSearch Error: " & Err.Number & " - " & Err.Description MsgBox "خطأ في البحث: " & Err.Number & vbCrLf & Err.Description, vbCritical Resume ExitHandler End Select Resume Next ExitHandler: End Sub Private Function ReplaceMultiple(inputText As String) As String Dim result As String: result = inputText result = Replace(result, "'", "''") result = Replace(result, "[", "[[]") result = Replace(result, "?", "[?]") result = Replace(result, "*", "[*]") result = Replace(result, """", """""") ReplaceMultiple = result End Function Private Sub ApplyHighlightsOnly(frm As Form, fieldNames As String, searchText As String) Dim arr() As String: arr = Split(fieldNames, ",") Dim words() As String: words = Split(searchText, " ") Dim i As Integer, w As Integer, fld As String Dim ctrl As Control, expr As String, safeWord As String On Error GoTo ErrHandler Application.Echo False For i = 0 To UBound(arr) fld = Trim(arr(i)) Set ctrl = frm.Controls(CTRL_PREFIX & fld) On Error Resume Next Do While ctrl.FormatConditions.Count > 0 ctrl.FormatConditions(1).Delete Loop On Error GoTo ErrHandler expr = "Nz([" & fld & "], """")" For w = 0 To UBound(words) If Len(Trim(words(w))) > 0 Then safeWord = ReplaceMultiple(Trim(words(w))) expr = "Replace(" & expr & ",""" & safeWord & """,""<font color=red>" & safeWord & "</font>"")" End If Next w ctrl.ControlSource = "=IIf(Len(" & expr & ")>0, " & expr & ", """")" Next i Application.Echo True Exit Sub ErrHandler: Application.Echo True Debug.Print "ApplyHighlightsOnly Error: " & Err.Number & " - " & Err.Description & " (Field: " & fld & ")" End Sub Private Sub ResetAllHighlights(frm As Form, fieldNames As String) Dim arr() As String: arr = Split(fieldNames, ",") Dim i As Integer, fld As String, ctrl As Control On Error GoTo ErrHandler Application.Echo False For i = 0 To UBound(arr) fld = Trim(arr(i)) Set ctrl = frm.Controls(CTRL_PREFIX & fld) On Error Resume Next Do While ctrl.FormatConditions.Count > 0 ctrl.FormatConditions(1).Delete Loop On Error GoTo ErrHandler ctrl.ControlSource = "=[" & fld & "]" Next i Application.Echo True Exit Sub ErrHandler: Application.Echo True Debug.Print "ResetAllHighlights Error: " & Err.Number & " - " & Err.Description End End Sub Private Function BuildFilterSQL(fieldNames As String, searchText As String) As String On Error GoTo ErrHandler Dim arrFields() As String: arrFields = Split(fieldNames, ",") Dim words() As String: words = Split(searchText, " ") Dim conditions As String, i As Integer, w As Integer Dim wordCond As String, safeWord As String For w = 0 To UBound(words) If Len(Trim(words(w))) > 0 Then safeWord = ReplaceMultiple(Trim(words(w))) wordCond = "" For i = 0 To UBound(arrFields) If i > 0 Then wordCond = wordCond & " OR " wordCond = wordCond & "[" & Trim(arrFields(i)) & "] Like '*" & safeWord & "*'" Next i If Len(conditions) > 0 Then conditions = conditions & " AND " conditions = conditions & "(" & wordCond & ")" End If Next w BuildFilterSQL = IIf(Len(conditions) = 0, "", conditions) Exit Function ErrHandler: BuildFilterSQL = "" Debug.Print "BuildFilterSQL Error: " & Err.Number & " - " & Err.Description End Function إعدادات النموذج المطلوبة مربع نص البحث باسم : txtSearch مربعات نص الحقول المطلوب البحث بداخلها : يجب ان تكون غير منضمة : Unbound يجب ان تكون Rich Text يجب ان تكون بنفس اسم الحقل تماما وتسبقها البادئة : txt فمثلا فى المرفق الحقول المطلوب البحث بداخلها كانت باسم :item_na, class_no اذن اسماء مربعات النص فى النموذج لتلك الحقول سوف تكون بالاسماء: txtitem_na, txtclass_no مصدر بيانات النموذج (Record Source) :اسم الجدول او استعلام للجدول عادى Query/Table الاكواد المطلوبة فى النموذج ثابت لادراج اسماء الحقول المراد البحث بداخلها مثل Private Const strUniversalfieldNames As String = "item_na,class_no" وفى حدث تحميل النموذج Private Sub Form_Load() InitUniversalSearch Me, strUniversalfieldNames End Sub أحداث مربع النص الخاص بالبحث : txtSearch يمكن استخدام حدث عند التغيير (Change) أو حدث بعد التحديث (AfterUpdate) ولكن الافضل فى السرعة والاداء خاصة مع كثرة عدد السجلات او عند استخدام التطبيق فى شبكة محلية لضمان الكفائة فى الاداء والسرعة يفضل استخدام الكود التالى فى حدث بعد التحديث (AfterUpdate) UpdateSearch Me.txtSearch, Me, strUniversalfieldNames ولكن انا فقط فى المرفق استخدمت حدث عند التغيير لرؤية النتيجة فورية فقط وبعد ذلك يمكن عمل زر امر لعمل مسح للفلاتر ولمربع النص او كود فى حدث النقر المزدوج لمربع البحث : txtSearch Me.txtSearch.Value = "" UpdateSearch Me.txtSearch, Me, strUniversalfieldNames واخيرا المرفق Search Highlights.accdb

السلام عليكم تم عمل الاحصائيات الملف المرفق به الاحصاء Plateform3.xlsb الشريط المتحرك ليس لدي جلفية لعملة ولا اراه مهما لانه سيسبب ثقل للملف ا1ذا تحققت طلباتك ارجو فتح موضوع جديد لاي طلب جديد وهذا حسب قوانين المنتدى

تم تعديل مثالك ليتم إظهار الجداول في القائمة وحذف بيانات الجدول المحدد وإعادة الترقيم من 1 نسخ قاعدة البيانات قبل الحدف.accdb

اعرض الملف أداة إظهار الرسائل في منطقة الإشعارات {سلسلة الأدوات المساعدة المخصصة} أقدم لكم اليوم أداة جميلة ستجعل تطبيقاتكم تظهر بمظهر برامج ويندوز الأخرى وذلك لأنها تسمح لكم بإظهار رسائل التنبيه في منطقة الإشعارات كما بالصورة يتميز هذا النوع من الرسائل عن مربع الرسائل المعروف في أنها لا تكون منبثقة أمام بقية النماذج ولاتتسبب في إيقاف العمل لإغلاقها تشمل هذه الرسالة عنوان ونص وأيقونة كما بالصورة العمل بالأداة سهل جداً وكما يقولون بأن الصورة تعادل ألف كلمة فقد أرفقت معها صورة متحركة توضح طريقة العمل بها بالإضافة إلى بعض التعليمات الإضافية تجدونها داخل الملف المرفق والتي توضح الشروط الواجب توافرها حتى تعمل بنجاح وكيفية الإستفادة منها في تطبيقاتكم الخاصة أرجو أن تنال إعجابكم تحياتي صاحب الملف منتصر الانسي تمت الاضافه 03/22/26 الاقسام قسم الأكسيس  

وعليكم السلام ورحمة الله وبركاته اليك التعديل المطلوب Horaire1.xlsb

وتنفيذاً للوعد الذي وعدته للأخ @Moosak قمت بإضافة أداة مساعدة في إنشاء صيغ أوامر مربع الرسائل MsgBox إلى مكتبة الموقع

أعضاء المنتدى الكرام ... كل عام وانتم بخير ... إليكم أحبائي كنترول جدارات الصف الاول كامل مفتوح المصدر وبدون قيود داعيا الله ان يكون عملا خالصا لوجه تعالى وان يكون عملا ينتفع به الكنترول يشمل الآتي تنبيه : كنترول جدارات الصف الثاني جاري التحضير له ان شاء الله تعليمات الدخول لشاشة البرنامج 1- تحويل اللغة الى الانجليزية 2- التحويل الى حروف كبيرة Caps Lock 3- اكتب في المربع الاول بحروف عربية "بسم" 4- - اكتب في المربع الثاني بحروف عربية "الله" 5- اضغط تاكيد وبالتوفيق ان شاء الله offcinal_1_3am.xlsb

بارك الله فيك وزدك الله من فضله .. وجعل الله هذا العمل فى ميزان حسناتك ان شاء الله وبالتوفيق والنجاح دائماَ

اولا: فى عدد 2 مستخدمين سوبر ادمن لا تنطبق عليهم صلاحيات واذونات المجموعات وهم s Deve والبيانات و كلمات السر لهم كما هى موضحة فى الكود ''--- ثوابت الدخول الخاصة Public Const cnstStrSuperUser As String = "s" Public Const cnstStrSuperPass As String = "s" Public Const cnstStrDevelopersUser As String = "Deva" Public Const cnstStrDevelopersPass As String = "d" طيب بما ان صاحب الافكار كل تفكيره كان ينحصر فى حصول الجميع على الافكار على طبق من ذهب لم يحاول اخفاء الاسم وكلمات مرور سوبر ادمن بكلمات مرور بطريقة مشفرة وكذلك لم يحاول اضافة طبقات تعمية مختلفة على الاكواد لان الهدف نشر العلم والمعرفة والافكار الالية ووجهة النظر كانت فى هذه النقطة كالاتى عدد 2 مستخدم سوبر ادمن لا تنطبق عليهم اى صلاحيات احدهم واضح وله بيانات داخل جدول المستخدمين المستخدم : Deve اما الاخر هو المستخدم : s والذى يعمل بدون وجود اى بيانات له داخل الجدول اى انه مستخدم شبح لا وجود له فى الجدول وغير مرئى ولا يمكن تعديل كلمة المرور له نعم من يريد اضافة التحقق من الصلاحيات لاى نموذج فقط يستطيع اضافة الحدث التالى فقط Private Sub Form_Open(Cancel As Integer) If Not funCheckPermissions(Me) Then Cancel = True End Sub أو كما فى التقرير Private Sub Report_Open(Cancel As Integer) If Not funCheckPermissions(Me) Then Cancel = True: Exit Sub End Sub طيب تم رفع المرفق كما هو حتى بالاكواد والافكار التى تم تعطيلها اثناء التطوير وبدون اضافة اكواد التحقق باستثناء النموذج : frmTestPer وكذلك التقرير : rptTest حتى انه تم استخدام كلمة Test للتأكيد على انها التى تخص التجربة ولذلك فقط تم وضح اكواد التحقق بداخلهم المرفق متاح للجميع مفتوح لمن يريد تعديل او تغيير اى شئ وفى توضيح كمان صغير مهم فى شاشة تسجيل الدخول لو لاحظت فى وضع التصميم توجد ازرار مخفية وهة المؤطرة باللون الاصفر تعمل فقط عندما تتم استخدام بيانات اى مستخدم سوبر ادمن بحيث تمكنه من فتح نماذج محددة دون فتح النظام بالكامل يستطيع مطور النظم تعديلها كما يحلو له تقدمت فى بداية كلامى ان العمل هدية وتم مشاركتها بعد اخذ الاذن من صاحب العمل ولكن تقريبا انا قمت بفحص العمل تقريبا بشكل شبه شامل من وجهة نظرى المتواضعة العمل يقترب فى الافكار والتطبيق من درجة الامتياز لانه يمكن مدير النظام من عمل الصلاحيات مرة واحدة لمجموعات العمل او حتى اضافة مجموعة واحدة فى المستقبل وتحديد الاذونات والصلاحيات المطلوبة لها ولكن بمجرد اضافة المستخدمين ايا كان العدد للمستخدمين لن يضطر لتحديد الاذونات والصلاحيات لكل مستخدم جديد فقط تحديد مجموعة العمل للمستخدم تنطبق عليها الاذونات والصلاحيات الخاصة بهذه المجموعة كما انه يمكن نقل المستخدم مستقبلا من مجموعة الى اخرى بسهولة وبذلك سوف ينطبق عليه صلاحيات واذونات المجموعة الجديدة فورا و فورا حتى لو كان المستخدم كان فى جلسة العمل نفسها التى كانت تعتمد الصلاحيات والاذونات للمجموعة القديمة حتى لو ينهى المستخدم جلسة العمل السابقة ويدء جلسة عمل جديدة لم اقم بتجربة هذه النقطة ولكن هذا ما بدا لى عندما قمت بتحيليل العمل ومن افضل ما اعجبنى فى العمل هو هذه الشاشة والأكثر من رائعة سهولة اختيار النماذج والتقارير وتوضيح كل منهم بنوعه من المراد تطبيق الصلاحيات عليها او التى لم يتم اختيارها لتطبيق الصلاحيات الفكرة والية العمل والمرونة بصراحة ممتازة جدا جدا جدا اجمل الامنيات بالاستمتاع بالتجربة

مهو لو انت لابس البدلة ، كان رفعتها .. بس ماشي .. ارفع رابطها وأحاول ارفعهالك في مشاركتك ..

الاخ tamerfayed يرجى تعديل الإسم للغة العربية طبقا لتعليمات المنتدى مشكلة COUNTIFS $C$8:$C$795,AF8,$B$8:$B$795,$T$9 تعديل مدى البحث c / b من 795 إلى 1000 $C$8:$C$1000,AF8,$B$8:$B$1000,$T$9 OK Otlob Sheet -Feb ,2026.xlsx

السلام عليكم كلها جميلة وفعالة .. لولا هذا الــــ الشيفت .. المتمرد الصغير

تقبل الله صيامكم وقيامكم وكل عام وانتم بخير . الله أكبر الله أكبر لاإله إلا الله ....... الله اكبر الله اكبر ولله الحمد

.................................... الله أكبر الله أكبر لاإله إلا الله والله اكبر الله اكبر ولله الحمد ................................. تقبل الله صيامكم وقيامكم وكل عام وانتم بخير

اولا / الملف السابق به كودين كلاهما معاينة تم تعديل احدهما الى طباعة ثانيا :- للتطبيق على ملفك / احعل لغة الجهاز العربية وانسخ الكود المرفق وفي ملفك الاخر قم بالدخول إلى صفحة الفيجوال بيسك عن طريق التبويب Developer(المطور) ثم Visual Basic ثم من قائمة Insert اختر Module والصقه به واربطه بزر في الصفحة المراد ترقيمها ملاحطة/ الكود المرفق مهمته الطباعة مع الترقيم ان اردت المعاينة مع الترقيم بدون طباعة غير كلمة FALSE الى TRUE في الجملة ws.PrintOut From:=i, To:=i, Preview:=False Sub طباعة() Dim ws As Worksheet Dim totalPages As Long Dim i As Long Dim pageNum As Integer Set ws = ActiveSheet totalPages = (ws.HPageBreaks.Count + 1) * (ws.VPageBreaks.Count + 1) For i = 1 To totalPages pageNum = Application.WorksheetFunction.RoundUp(i / 2, 0) If i Mod 2 <> 0 Then ws.PageSetup.CenterFooter = "الصفحة " & Format(pageNum, "00") Else ws.PageSetup.CenterFooter = "تابع الصفحة " & Format(pageNum, "00") End If ws.PrintOut From:=i, To:=i, Preview:=False Next i End Sub

بعد إذن الأخ @Foksh يبدو أن المشكلة ناتجة عن إختلاف البيئة إلى بيئة x64 لذلك قمت بعمل Debug وتعديل الأسطر التي ظهر عندها خطأ الآن التطبيق يعمل عندي بدون مشاكل 2008.rar

اخي الكريم يجب عليك التفريق بين حالتين (الجداول/الإستعلامات و النماذج/التقارير) من حيث طريقة إستعراض البيانات المرتبطة بين جدولين ففي الجداول والاستعلامات يتم إظهارها بإستخدام ورقة البيانات الفرعية Subdatasheet وهي عبارة جدول أو إستعلام آخر مرتبط بهذا الجدول أو الإستعلام وبنفس الفكرة إذا أردنا إستعراض بيانات أخرى مرتبطة ببيانات النماذج والتقارير فيجب أن تكون فيما يسمى (النماذج الفرعية Subform أو التقارير الفرعية Subreport) بالتالي فإذا أردنا إظهار البيانات بالشكل المطلوب داخل النموذج فيجب أن تكون البيانات ضمن نموذج آخر يتم إدراجه كنموذج فرعي مرفق لك الملف بعد التعديل Sub-data_sheet.accdb

حذفت الماكرو .. فتم ابطال السحر

الله يبارك في حضرتك وفي أخي خليفة

مشاركة مع الحبايب

جرب التعديل التالي لا ننس كتابة اسم الملف في الحلية A2 الكل (1) (2).xlsm لا حرج ان اردت اي تعديل احر

السلام عليكم ورحمة الله وبركاته كان من الافضل ارفاق ملف للتطبيق عليه جرب الملف المرفق ببيانات افتراضية في النطاق A2:A100 ومعادلة الجمع في الخلية D2 ,DL ويمكنك نسحها الى اي خلية اخرى =IFERROR(SUMPRODUCT((A2:A100>0)*(SUBTOTAL(103;OFFSET(A2;ROW(A2:A100)-MIN(ROW(A2:A100));0)))*(A2:A100));0) جمع الأرقام الموجبة فقط الظاهرة دون المخفية.xlsx

شوف الحل ده هل هو المطلوب ؟ حساب الجمعة والسبت.accdb

اعرض الملف حافز التجريبي حافز التجريبي صاحب الملف أحمد عبد العاطي رشيدي تمت الاضافه 03/07/26 الاقسام قسم الإكسيل  

شكرا جزيلا وبارك الله فيك وغفر الله لنا ولكم بحق هذا الشهر الكريم

تفضل المرفق بعد التعديل بكل طلباتك . Saad-1.rar

بعد إذن الاخ @kkhalifa1960 من خاصية (التنسيق أو Format) لمربع النص قم بإزالة علامتي النجمة إفتح الجدول في عرض التصميم ومن خاصية (قناع الإدخال أو Input Mask) للحقل قم بكتابة Password ثم طبق نفس التعديل في مربع النص في النموذج أما إذا أردت أن يظل ظاهراً في الجدول وتريد إخفاؤه في النموذج فقط فطبق التعديل في مربع النص فقط تحياتي

كتابة باللغة العربية من صفحة نانو بنانا ذكاء اصطناعي

عمل صورة من خلال الذكاء الاصطناعي

وعليكم السلام ورحمة الله وبركاته يتم الامر في حطوة واحدة