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

أهلاً بكم في التحدي الثاني من سلسلة "الفعاليات والتحديات الشهرية". بعد الإستفتاء والإستطلاع الذي تم ؛ وقع اختيار المصوتين على الموضوع :- 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

وعليكم السلام -كان عليك ان تقوم بالتالى حدد العمود. اذهب إلى علامة التبويب بيانات (Data) > نص إلى أعمدة (Text to Columns) > إنهاء (Finish) ثم اكتب معادلة جمع عادية وستحصل على النتيجة المرجوة تقرير التأخير الشهري 11112.xlsx

السلام عليكم ضع المعادلة =SUM(C8:C12) بدل الموجودة في خلية الجمع = SUM(C8+C9+C10+C11+C12) وفي الخلية c6 اكتب المعادلة =EOMONTH(P1;0) خطأ في الجمع و نهاية الشهر.xlsx

تم تحديث الأداة مع إضافة هذا الخيار

جميل جداً .. شكراً لك على هذه المعلومة انا فعلاً وجدت في جوجل الموقع ده ، والرابط للخدمة :- https://www.everythingaccess.com/mdeconversion.asp أما موضوع اثبات الملكية ، يعني لازم أحلف لهم يمين مثلاً هههههههه ولا إيه بالضبط

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

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

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

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

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

وعليكم السلام ورحمة الله وبركاته كل عام وانت بخير الصفحات كثيرة وهذا سيجعل اي كود يستغرق وقتا اطول لاستدعاء البيانات استغرق على جهازي حوالي 6 دقائق بمعدل ثانية واحدة لكل صفحة فكرة الاكواد ؟ الكود الاول (اسعار الاسهم ) يتم تشغيله مرة واحدة فقط ويستغرق عدة دقائق بعدها يتم التعامل مع زر التحديت ويستغرق اقل من دقيقة واحدة من خلال 3 مواقع ذكاء اصطناعي تحصلت على افضل كود يقوم بالمهمة التجرية تمت على اكسل 2016 لانه ليس لدي 2010 واعتقد ان الكود يعمل علي 2010 زر التحديث / بعد استدعاء البيانات يقوم زر التحديث بمقارنة البيانات المستدعاة بالموقع واذا كان هناك تغير يقوم يالتحديث قم بالتجربة واعلمنا بالنتائج افضل الاكواد تحصلت عليها من موقع https://chat.deepseek.com/ us_stocks_arincen (1).xlsb

تفضل ترتيب درجات الطلاب لمواد مختلفة(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

وعليكم السلام ورحمة الله وبركاته الحل هو نقل الكود إلى موديول (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 اطيب الامانى

اعرض الملف توليد أرقام تلقائية مخصصة (ترقيم تلقائي احترافي) : Auto Increment توليد أرقام مستندات تلقائية مثل أرقام الفواتير والطلبات والسندات (ترقيم تلقائي احترافي) أربع أنماط للترقيم Yearly → INV-2026-000001 : التصفير واعادة الترقيم عند بدء العام الجديد Monthly → INV-2026-04-000001 : التصفير واعادة الترقيم عند بدء الشهر الجديد Daily → INV-2026-04-05-000001 : التصفير واعادة الترقيم عند بدء اليوم الجديد Sequential→ INV-000001 : ترقيم لا نهائى بدون اعادة بدء الترقيم مستمر بلا توقف المزايا : إنشاء تلقائي لجدول التسلسل : tblSequences وظيفته تخزين تسلسل الأرقام الفريد لكل مفتاح (Key) استرداد ذكي عند حذف جدول التسلسل : tblSequences عن طريق الخطأ تم تصميم الكود بحكمة ليعيد إنشاءه تلقائيا ويستأنف الترقيم من آخر رقم موجود في جدول البيانات الأصلي - أى لا انقطاع ولا تكرار أبدا التحكم الأمثل لإضافة بادئة مخصصة أى أنه يمكن عمل أكثر من عملية ترقيم لنفس الحقل حسب النوع, الفرع , المحافظة مثلا .... Cairo-2026-000018 Alex-2026-000001 التحكم فى شكل تنسيق الترقيم للأرقام بطول سلسلة مخصصة من 1 الى 10 مثل : 000001 أو 0000000001 أو حتى آمن في بيئة الشبكة المتعددة المستخدمين: عدم تكرار أي رقم حتى لو فتح عشرة مستخدمين نفس النموذج في نفس اللحظة مع عمل معالجة خاصة لمنع تعارض الطلبات المتزامنة مع حد أقصى للمحاولات لمنع التوقف التام تحت الضغط الشديد صاحب الملف عسل قليل الدسم تمت الاضافه 04/05/26 الاقسام قسم الأكسيس  

تفضل اخي الكريم تعديل معادلة.xlsx

اعرض الملف أداة عرض وتحرير جمل Sql داخل التطبيق {سلسلة الأدوات المساعدة المخصصة} اقدم لكم اليوم أداة ستزيد من إنتاجيتكم أثناء العمل مع الإستعلامات فبدلاً من العمل مع الإستعلامات من خلال جزء التنقل ستقوم هذه الأداة بتجميع جميع الإستعلامات داخل مربع قائمة والجميل أنه لن يتم تحميل القائمة إلا بالإستعلامات التي تم تحديد نوعها فمثلاً تريد العمل مع إستعلامات التحديث فقط أو الإلحاق فقط وهكذا بالإضافة إلى هذا يمكنك تصفية النتائج من خلال كتابة عبارة نصية تتضمنها جملة Sql فمثلاً تريد الإستعلامات التي تتضمن بيانات جدول محدد فيكفي أن تكتب إسم الجدول في مربع التصفية ليتم تصفية الإستعلامات التي تتضمن هذا الجدول فقط وكمثال رائع آخر وأعتقد أن جميعنا سيعجب به إذا قمنا مثلا بتعديل إسم عنصر تحكم في نموذج وسبق أن تم وضع عنصر التحكم هذا كمعيار لتصفية إستعلام أو أكثر فيمكن كتابة إسمه في مربع التصفية ليتبقى لدينا الإستعلامات التي ذكر فيها إسم عنصر التحكم هذا لا وأزيدكم من الشعر بيت يمكنكم بعد ذلك إستبدال إسم عنصر التحكم هذا بالإسم الجديد وإستعراض النتائج في إستعلام مؤقت وإذا نجح العمل يمكنك تحديث جملة Sql الخاصة بالإستعلام المحدد بالتعديلات الجديدة وهذا كله عن طريق الأداة وبدون حتى أن تضطر إلى فتح الإستعلام في وضع التصميم يوجد للأداة وظيفة أخرى وهي تعديل جملة Sql الخاصة بعناصر التحكم (مربعات التحرير والسرد ومربعات القائمة) وتقوم بنفس ماسبق ذكره ولكن على عبارة Sql لمصدر الصف الخاص بعنصر التحكم الأداة بسيطة ولا تحتوي إلا على ثلاثة نماذج فقط ستجدونها في المرفق بإسم القالب يمكنكم إستيرادها إلى تطبيقاتكم والعمل بها بكل سهولة ولكن الخيار المفضل لدي هو إستخدامها كوظيفة إضافية وهي ما ستجدونه داخل مجلد الوظيفة الإضافية مع مستند يشرح طريقة تثبيتها أرجو أن تجدوا في هذه الأداة الفائدة التي وجدتها أنا شخصيا وإذا كان لدى أي أحد منكم أي ملاحظات فالرجاء أن لا يبخل علينا بها تحياتي صاحب الملف منتصر الانسي تمت الاضافه 04/01/26 الاقسام قسم الأكسيس  

تم رفع إصدار محدث من الأداة حيث تم تحسين طريقة العرض حتى يسهل العمل مع جمل Sql بحيث أصبحت تظهر بشكل منسق كما بالصورة

حل آخر بالكود: Private Sub Worksheet_Change(ByVal Target As Range) Dim Row As Integer, Col As Integer Dim fRow As Integer, fCol As Integer, fdd As Integer Dim yy As Integer, mm As Integer, dd As Integer Dim cellDate As Date, m m = Array("", "يناير", "فبراير", "مارس", "أبريل", "مايو", "يونيو", _ "يوليو", "أغسطس", "سبتمبر", "أكتوبر", "نوفمبر", "ديسمبر") With Target If Not (Target.Row = 1 And Target.Column = 13) Then Exit Sub yy = Year(.Value) mm = Month(.Value) For fdd = 1 To 7 If Weekday(DateSerial(yy, mm, fdd)) = vbSunday Then Exit For Next fdd End With Cells.Find(What:="الأحد", After:=ActiveCell, LookIn:=xlFormulas, _ LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _ MatchCase:=False, SearchFormat:=False).Activate fRow = ActiveCell.Row fCol = ActiveCell.Column + 1 Application.EnableEvents = False Application.ScreenUpdating = False Cells(fRow - 2, fCol + 5) = m(mm) dd = fdd - 3 For Col = fCol To fCol + 9 Step 2 dd = dd + 2 For Row = fRow To fRow + 4 dd = dd + 1 cellDate = DateSerial(yy, mm, dd) If Month(cellDate) = mm Then Cells(Row, Col + 0) = cellDate Cells(Row, Col + 1) = 1 Else Cells(Row, Col + 0) = "" Cells(Row, Col + 1) = "" End If Next Row Next Col Application.EnableEvents = True Application.ScreenUpdating = True End Sub حساب_التاريخ_05.xlsm

وعليكم السلام Private Sub cm_ToExcel_Click() On Error GoTo Err_cm_ToExcel_Click Dim stDocName As String Dim Q As Integer Dim sh As Object Dim folder As Object Dim FolderPath As String Dim FilePath As String stDocName = "tbl_Teacher_" & [Year_name] Q = DCount("*", "tbl_Teacher") If Q > 0 Then ' اختيار مجلد Set sh = CreateObject("Shell.Application") Set folder = sh.BrowseForFolder(0, "اختر مجلد حفظ الملف", 0) ' لو إلغاء If folder Is Nothing Then Exit Sub FolderPath = folder.Items().Item().Path FilePath = FolderPath & "\" & stDocName & ".xls" ' 🔥 التحقق من وجود الملف If Dir(FilePath) <> "" Then If MsgBox("الملف موجود بالفعل:" & vbCrLf & FilePath & vbCrLf & vbCrLf & _ "هل تريد استبداله؟", _ vbYesNo + vbQuestion + vbMsgBoxRight, "تأكيد") = vbNo Then Exit Sub End If End If ' التصدير DoCmd.TransferSpreadsheet acExport, 8, "tbl_Teacher", FilePath, False MsgBox "تم حفظ الملف بنجاح في:" & vbCrLf & FilePath, vbInformation + vbMsgBoxRight, "تم" Else MsgBox "لا يوجد سجلات لتصديرها", vbExclamation + vbMsgBoxRight, "تنبيه" End If Exit_cm_ToExcel_Click: Exit Sub Err_cm_ToExcel_Click: MsgBox Err.Description Resume Exit_cm_ToExcel_Click End Sub

السلام عليكم نعم المشكلة من حماية الشيتات اليك التعديل مع اظافة الترقيم التلقائي لرقم التسجيل Plateform (1) .xlsb

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

اهلا استاذ سعيد جدا بمرورك واسعدتنى كلماتك واكثر ما اسعدنى هو اعجابك بهذا الجنون

أنا جربت التعديل الأخير UniversalSearch Pro v2.01 وهو رائع حقاً. . وأقترح في نموذج الاعدادات: frmSearchSettings وجود إمكانية لظهور حقول الجدول مصدر البيانات بتسميات اخرى على اعتبار أن المستخدم ربما لا يعلم مدلول اسماء الحقول. أو ظهورها كما تم تسميتها في خصائص الحقل: Caption فمثلا تظهر : كود الصنف اسم الصنف مجموعة الصنف رصيد الصنف بدلا من : item_id item_na class_no item_balance .

* وظيفة LIKE تستخدم لمقارنة النصوص مع نمط (Pattern) معيّن. النمط يحتوي على رموز خاصة (Wildcards) تسمح بالبحث الجزئي أو المرن داخل النصوص. * أمثلة عملية في VBA Dim txt As String txt = "Mahdi" ' مثال 1: البحث عن نص يبدأ بـ "M" If txt Like "M*" Then MsgBox "يبدأ بحرف M" End If ' مثال 2: نص مكون من 5 أحرف بالضبط If txt Like "?????" Then MsgBox "النص يحتوي على 5 أحرف" End If ' مثال 3: نص ينتهي بـ "di" If txt Like "*di" Then MsgBox "ينتهي بـ di" End If ' مثال 4: نص يحتوي على رقمين متتاليين Dim code As String code = "AB12" If code Like "*##" Then MsgBox "ينتهي برقمين" End If

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

أعجز عن وصف شعوري بهذا الكلام من أستاذ كبير مثلك 🥰

وعليكم السلام ورحمة الله وبركاته اليك التعديل المطلوب Horaire1.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 للتأكيد على انها التى تخص التجربة ولذلك فقط تم وضح اكواد التحقق بداخلهم المرفق متاح للجميع مفتوح لمن يريد تعديل او تغيير اى شئ وفى توضيح كمان صغير مهم فى شاشة تسجيل الدخول لو لاحظت فى وضع التصميم توجد ازرار مخفية وهة المؤطرة باللون الاصفر تعمل فقط عندما تتم استخدام بيانات اى مستخدم سوبر ادمن بحيث تمكنه من فتح نماذج محددة دون فتح النظام بالكامل يستطيع مطور النظم تعديلها كما يحلو له تقدمت فى بداية كلامى ان العمل هدية وتم مشاركتها بعد اخذ الاذن من صاحب العمل ولكن تقريبا انا قمت بفحص العمل تقريبا بشكل شبه شامل من وجهة نظرى المتواضعة العمل يقترب فى الافكار والتطبيق من درجة الامتياز لانه يمكن مدير النظام من عمل الصلاحيات مرة واحدة لمجموعات العمل او حتى اضافة مجموعة واحدة فى المستقبل وتحديد الاذونات والصلاحيات المطلوبة لها ولكن بمجرد اضافة المستخدمين ايا كان العدد للمستخدمين لن يضطر لتحديد الاذونات والصلاحيات لكل مستخدم جديد فقط تحديد مجموعة العمل للمستخدم تنطبق عليها الاذونات والصلاحيات الخاصة بهذه المجموعة كما انه يمكن نقل المستخدم مستقبلا من مجموعة الى اخرى بسهولة وبذلك سوف ينطبق عليه صلاحيات واذونات المجموعة الجديدة فورا و فورا حتى لو كان المستخدم كان فى جلسة العمل نفسها التى كانت تعتمد الصلاحيات والاذونات للمجموعة القديمة حتى لو ينهى المستخدم جلسة العمل السابقة ويدء جلسة عمل جديدة لم اقم بتجربة هذه النقطة ولكن هذا ما بدا لى عندما قمت بتحيليل العمل ومن افضل ما اعجبنى فى العمل هو هذه الشاشة والأكثر من رائعة سهولة اختيار النماذج والتقارير وتوضيح كل منهم بنوعه من المراد تطبيق الصلاحيات عليها او التى لم يتم اختيارها لتطبيق الصلاحيات الفكرة والية العمل والمرونة بصراحة ممتازة جدا جدا جدا اجمل الامنيات بالاستمتاع بالتجربة

عملت بعض التعديلات خصوصاً للتقارير .. والبرنامج يعمل لديا بدليل الشرح التالي . وايضاً اليك المرفق بعد التعديل . SaadPermissionsLast-3.rar

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

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

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

و عليكم السلام ورحمة الله وبركاته. تفضل الحل اجتهاد مني و بمساعدة الذكاء الصناعي و إن شاء الله أحد أساتذة المنتدى يقوم بالتطوير أو يقدم إضافات يوجد ملفين الأول ProtectedWorkbook وهو خاص بالعميل الثاني KeyGenerator وهو خاص بك لتوليد المفاتيح التي سيستخدمها العميل لتحويل الملف من تجريبي لدائم خطوات العمل . 1.العميل يفتح الملف 2. يرسلك محتوى خلية B6 Machine ID مثال: DESKTOP-ABC123_AHMED 3. تفتح KeyGenerator.xlsm تكتب اسم العميل + تلصق الـ Machine ID تضغط "توليد الكود" 4. يظهر لك مثلا: ACT-05837291 ترسله للعميل 5.العميل يدخله في B12 ويضغط "تفعيل" ProtectedWorkbook.xlsmلا تنسى وضع كلمة سر لمحرر الأكواد أخيرا لا يوجد حماية 100% في Excel لأن المستخدم يقدر يعطل الماكرو أو يكسر الحماية لا تنسى وضع كلمة سر لمحرر الأكواد كيف يعمل النظام: · أول 3 أيام يعمل طبيعي مع رسالة "متبقي X أيام" · بعد 3 أيام يُقفل ويطلب كود تفعيل · نقل لجهاز جديد يكتشف الفرق ويطلب كود جديد · تفعيل صحيح يُفتح نهائياً على ذلك الجهاز أخيرا لا يوجد حماية 100% في Excel لأن المستخدم يقدر يعطل الماكرو أو يكسر الحماية KeyGenerator.xlsm

اولا / الملف السابق به كودين كلاهما معاينة تم تعديل احدهما الى طباعة ثانيا :- للتطبيق على ملفك / احعل لغة الجهاز العربية وانسخ الكود المرفق وفي ملفك الاخر قم بالدخول إلى صفحة الفيجوال بيسك عن طريق التبويب 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

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

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

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

السلام عليكم ورحمة الله وبركاته كان من الافضل ارفاق ملف للتطبيق عليه جرب الملف المرفق ببيانات افتراضية في النطاق 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

اليك الملف البحث في القائمة بالحروف.xlsm