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

السلام عليكم ورحمة الله وبركاته 🙂🖐 يقول المثل : أن تأتي متأخرا خير من أن لا تأتي 😅✌ بعد جهد جهيد إنتهيت من تصميم نظام تسجيل دخول + نظام صلاحيات متطور كلما أخطو فيه خطوة أجد أنه ناقص وتطلع أفكار جديدة .. 😅👊 لذلك قلت سأنزلها كما هي الآن .. حاولت تبسيطه للمستخدم والمستفيدين منه لاحقا قدر المستطاع .. وسأبدأ بواجهة تسجيل الدخول المتواضعة : المزايا : حفظ بيانات دخول المستخدم (اختياري) الدخول مباشرة بمجرد كتابة كلمة المرور بشكل صحيح (تسريع عملية الدخول) ملاحظة : جميع كلمات المرور في البرنامج : 123 ثانيا الواجهة الرئيسية : يتم تطبيق الصلاحيات للمستخدم بمجرد تسجيل الدخول .. ثالثا : إدارة المستخدمين هنا يتم إدارة جميع ما يتعلق بمستخدمي البرنامج ( إضافة ، تعديل ، حذف ، تعيين الصلاحيات ) رابعا : إدارة مجموعات العمل والصلاحيات لكل مجموعة هنا يتم ضبط الصفحات المسموح لكل مجموعة دخولها والصلاحيات الخاصة بكل صفحة .. ومثل ماهو واضح يمكن إضافة النماذج أو إزالتها كما يحلو لك وبعد ضبط مجموعات العمل يتم تعيين كل مستخدم للمجموعة الخاصة به ، ويمكن عمل مجموعة خاصة لشخص واحد فالخيارات غير محدودة .. 🙂 الآن يمكنك الخروج من البرنامج ثم تجربة تسجيل الدخول باسم المستخدمين المسجيلين في البرنامج للاستمتاع بتجربة الصلاحيات الممنوحة لكل مستخدم 😊 وبعد الدخول للصفحات يتم تطبيق الصلحيات الخاصة بالنموذج أيضا .. وبقية الصلاحيات ستظهر حسب الزر الذي يتم الضغط عليه مزايا إضافية موجودة في البرنامج .. ولها علاقة بالأمان أيضا .. نظام النسخ الاحتياطي وله إعدادات خاصة به (نسخ احتياطي يدوي أو تلقائي ) وهو موجود في صفحة إعدادات البرنامج : ولكل مستخدم مجموعة خيارات يمكنه التحكم بها مثل ( تغيير كلمة المرور ، التشغيل عند إقلاع الجهاز ، إنشاء اختصار في سطح المكتب ، حفظ بيانات التسجيل لتسريع الدخول للبرنامج) هذه هي أهم الميزات التي يحتويها البرنامج 🙂 ولفتح البرنامج في وضع التصميم ، حتى هذي سهلة للمبرمج 😅🖐 في صفحة تسجيل الدخول وكذلك الصفحة الرئيسية يوجد هذا الزر الخاص بالمبرمج >> بعد الضغط عليه >> أدخل كلمة المرور : 123 ويمكنك تغييرها من الكود الخاص بالزر .. بتظهر لك هذي النافذة الخاصة بالمبرمج فقط : وأهم ما فيها : (1) عرض الشريط العلوي ونافذة الأكسس >> بعد تفعيله تحفظ وتشغل الماكرو وبتنفتح عندك واجهة الأكسس >> أعد تشغيل البرنامج من جديد للحصول على جميع الميزات. (2) اسم نموذج البداية >> وهو أو نموذج بيشتغل معاك في البرنامج >> وهذا يسهل على المبرمج تطبيق النظام على أي برنامج آخر 🙂 (3) اسم البرنامج (واللي ييظهر في الشريط العلوي للأكسس) : (4) رقم الإصدار (نسخة البرنامج) وتاريخها >> ويمكن الاعتماد عليها لتحديث البرنامج لاحقا .. (5) إدارة نماذج الصلاحيات >> وهي النماذج اللي ستسمح بإعطاء صلاحيات لدخولها للبرنامج .. وكذلك تعطي كل نموذج اسم صديق للمستخدم وسيتم استخدام المسمى الحقيقي للنموذج داخليا .. وهكذا أكون شرحت لكم أهم المميزات ويتبقى نقطة مهمة وهي : يمكن للمبرمج الآن الاستفادة من هذا الملف فهو قاعدة جاهزة لإنطلاق في تصميم برنامجك الخاص .. جميع الأكواد الخاصة بالصلاحيات ستجدها في الموديول التالي : وأهم ما ستحتاج معرفته في كيفية تطبيق الصلاحيات ذكرته في الملاحظات المكتوبة أول الموديول : ' (1) : لتطبيق صلاحية فتح النماذج وصلاحيات الإضافة والتعديل والحذف تضع الأسطر التالية أول الأكواد في حدث فتح النموذج '------------------------------------------------------------------------------- 'Private Sub Form_Open(Cancel As Integer) ' ' فحص صلاحة دخول النموذج ' Cancel = Not Permission_OpenForm(Me.Name, True) ' ' تطبيق صلاحيات : الإضافة / التعديل / الحذف ' Apply_Addition_Edits_Delete_Permissions (Me.Name) 'End Sub '------------------------------------------------------------------------------- ' (2) : لتطبيق صلاحيات الطباعة والاستيراد والتصدير داخل نموذج معين تكتب هذه الأسطر لمعرفة وجود الصلاحة من عدمها ' : وكل سطر من هذه الصلاحيات يرجع لك النتيجة كما يلي ' True : مسموح ' False : ممنوع '------------------------------------------------------------------------------- ' 1- فحص صلاحية الطباعة (True/False) ' Permission_Print(Me.Name , True) ' |_>> (True/False) : هذه الجزئية اختيارية لعرض رسالة تنبيه عند عدم وجود صلاحية من عدمها ' 2- فحص صلاحية الاستيراد (True/False) ' Permission_Import(Me.Name , True) ' |_>> (True/False) : هذه الجزئية اختيارية لعرض رسالة تنبيه عند عدم وجود صلاحية من عدمها ' 3- فحص صلاحية التصدير (True/False) ' Permission_Export(Me.Name , True) ' |_>> (True/False) : هذه الجزئية اختيارية لعرض رسالة تنبيه عند عدم وجود صلاحية من عدمها '------------------------------------------------------------------------------- والنماذج الموجودة في البرنامج مع أزرارها تم تطبيق الأكواد عليها بشكل عملي << راجعها وأدرسها لمعرفة كيفية عملها .. وهي سهلة يسيرة بفضل الله 🙂 وهذا مثال عملي لتطبيق الصلاحية على زر الطباعة (فتح التقرير) مثلا : وهكذا بقية الصلاحيات (اطلع على بقية الموديول) تم تحويلها لأسطر قليلة بسيطة للاستفادة منها بكل يسر .. 🙂 وأخيرا تحميل البرنامج :: Moosak ‏‏Login System with permissions 1.0.zip :: وآخر دعوانا أن الحمد لله رب العالمين ::

برنامج صغير خفيف .. يخدم الايجار اليومي وغيره ويصلح لأي خدمة ايجارات قابل للتطوير بمجرد تنفيذ اجراء الايجار يطبع فاتورة استلام .. وعند تنفيذ اجراء الارجاع يطبع فاتورة بالمبالغ المستحقة حاليا هذه الفواتير تفتح كتقارير يتم عرضها .. وهي مصممة للعمل على الطابعة الحرارية امل ان تجدوا المتعة والفائدة كلمة المرور = 1 Equps.rar

استكمالاً للموضوع القديم هنا ، تم بحمد الله وفضله ؛ إطلاق النسخة الأولى من اللعبة الشهيرة الدومينو ، ولكن بنكهتي التي تعودت عليها 😊 .. اللعبة لن تحتاج شرح عنها ، سوى كيفية اللعب .. ضبط الإعدادات :- في نموذج البداية والمخصص لإعدادات اللعبة . انقر الزر لعبة محلية. اللاعب الأول = الخصم وهو الكمبيوتر . واللاعب الثاني هو أنت عزيزي اللاعب . من يبدأ اللعبة هو الذي يكون لديه حجر الدش الأكبر ( إن وجد ) ، أو اللاعب الذي لديه أكبر حجر . الرقم 100 هو رقم افتراضي للمجموع الذي سيكون الفائز من يصل إليه أولاً . نقاط الفوز = مجموع الأرقام في الحجارة التي في يد اللاعب الخسران . والفائز يحصل على مجموع النقاط هذه . صورة واجهة الإعدادات . كيفية اللعب على النسخة المحلية :- عند بدء اللعبة ، اللاعب الذي لديه أكبر حجر مزدوج ( الدش ) هو من يبدأ اللعب .. لمعرفة وظيفة كل زر فقط قف عليه لتعرف ظيفته في اللعبة ، وعدد الأزرار = 4 وهي :- زر بدء الجولة الجديدة . * زر سحب حجر من الكومة ( عندما لا يكون لديك او لدى الكمبيوتر حجر صالح للعب ) . * زر تسليم الدور . ويكون متاحاً عندما لا يكون لدى الكومة ( البنك ) حجارة ، وبالطبع عندما لا يكون لديك حجر صالح لتلعبه بينما الكمبيوتر أو اللاعب الآخر لديه حجر صالح للرمي . أما عند عدم وجود حجارة صالح للرمي مع كلا الطرفين ( ولم يتبق حجارة في الكومة - البنك - ) فتكون اللعبة قد أغلقت ، والنتيجة تحسم لصاحب العدد الأقل مجموعاً للحجارة بالفوز . * زر الغش 😁 ، وهو زر كشف حجارة الكمبيوتر . وعكسه زر الإخفاء . اللعب سيكون بالنقر المزدوج على الحجر الصالح للرمي بيدك . عند وجود حجر صالح للرمي باتجاهين ، لديك الحرية باختيار الجهة التي تريد رميه فيها بظهور مستطيل وهمي يمثل موقع الحجر . ( ستلاحظونه أثناء اللعب بسهولة و وضوح ) . صورة واجهة اللعبة . فيديو توضيحي لطريقة اللعب :- التحميل للإصدارين 32 و 64 من هنا . وقد تم رفعه على جوجل درايف لأن حجم الملف تقريباً بحدود 9 ميجا مع مجلد الصور .

اعرض الملف نظام تسجيل دخول احترافي، مع نظام صلاحيات متعدد المستويات السلام عليكم ورحمة الله وبركاته 🙂🖐 بفضل الله وتوفيقه أقدم لكم تصميم نظام تسجيل دخول + نظام صلاحيات متطور حاولت تبسيطه للمستخدم والمستفيدين منه لاحقا قدر المستطاع .. وسأبدأ بواجهة تسجيل الدخول المتواضعة : المزايا : حفظ بيانات دخول المستخدم (اختياري) الدخول مباشرة بمجرد كتابة كلمة المرور بشكل صحيح (تسريع عملية الدخول) ملاحظة : جميع كلمات المرور في البرنامج : 123 ثانيا الواجهة الرئيسية : يتم تطبيق الصلاحيات للمستخدم بمجرد تسجيل الدخول .. ثالثا : إدارة المستخدمين هنا يتم إدارة جميع ما يتعلق بمستخدمي البرنامج ( إضافة ، تعديل ، حذف ، تعيين الصلاحيات ) رابعا : إدارة مجموعات العمل والصلاحيات لكل مجموعة هنا يتم ضبط الصفحات المسموح لكل مجموعة دخولها والصلاحيات الخاصة بكل صفحة .. ومثل ماهو واضح يمكن إضافة النماذج أو إزالتها كما يحلو لك وبعد ضبط مجموعات العمل يتم تعيين كل مستخدم للمجموعة الخاصة به ، ويمكن عمل مجموعة خاصة لشخص واحد فالخيارات غير محدودة .. 🙂 الآن يمكنك الخروج من البرنامج ثم تجربة تسجيل الدخول باسم المستخدمين المسجيلين في البرنامج للاستمتاع بتجربة الصلاحيات الممنوحة لكل مستخدم 😊 وبعد الدخول للصفحات يتم تطبيق الصلحيات الخاصة بالنموذج أيضا .. وبقية الصلاحيات ستظهر حسب الزر الذي يتم الضغط عليه مزايا إضافية موجودة في البرنامج .. ولها علاقة بالأمان أيضا .. نظام النسخ الاحتياطي وله إعدادات خاصة به (نسخ احتياطي يدوي أو تلقائي ) وهو موجود في صفحة إعدادات البرنامج : ولكل مستخدم مجموعة خيارات يمكنه التحكم بها مثل ( تغيير كلمة المرور ، التشغيل عند إقلاع الجهاز ، إنشاء اختصار في سطح المكتب ، حفظ بيانات التسجيل لتسريع الدخول للبرنامج) هذه هي أهم الميزات التي يحتويها البرنامج 🙂 ولفتح البرنامج في وضع التصميم ، حتى هذي سهلة للمبرمج 😅🖐 في صفحة تسجيل الدخول وكذلك الصفحة الرئيسية يوجد هذا الزر الخاص بالمبرمج >> بعد الضغط عليه >> أدخل كلمة المرور : 123 ويمكنك تغييرها من الكود الخاص بالزر .. بتظهر لك هذي النافذة الخاصة بالمبرمج فقط : وأهم ما فيها : (1) عرض الشريط العلوي ونافذة الأكسس >> بعد تفعيله تحفظ وتشغل الماكرو وبتنفتح عندك واجهة الأكسس >> أعد تشغيل البرنامج من جديد للحصول على جميع الميزات. (2) اسم نموذج البداية >> وهو أو نموذج بيشتغل معاك في البرنامج >> وهذا يسهل على المبرمج تطبيق النظام على أي برنامج آخر 🙂 (3) اسم البرنامج (واللي ييظهر في الشريط العلوي للأكسس) : (4) رقم الإصدار (نسخة البرنامج) وتاريخها >> ويمكن الاعتماد عليها لتحديث البرنامج لاحقا .. (5) إدارة نماذج الصلاحيات >> وهي النماذج اللي ستسمح بإعطاء صلاحيات لدخولها للبرنامج .. وكذلك تعطي كل نموذج اسم صديق للمستخدم وسيتم استخدام المسمى الحقيقي للنموذج داخليا .. وهكذا أكون شرحت لكم أهم المميزات ويتبقى نقطة مهمة وهي : يمكن للمبرمج الآن الاستفادة من هذا الملف فهو قاعدة جاهزة لإنطلاق في تصميم برنامجك الخاص .. جميع الأكواد الخاصة بالصلاحيات ستجدها في الموديول التالي : وأهم ما ستحتاج معرفته في كيفية تطبيق الصلاحيات ذكرته في الملاحظات المكتوبة أول الموديول : ' (1) : لتطبيق صلاحية فتح النماذج وصلاحيات الإضافة والتعديل والحذف تضع الأسطر التالية أول الأكواد في حدث فتح النموذج '------------------------------------------------------------------------------- 'Private Sub Form_Open(Cancel As Integer) ' ' فحص صلاحة دخول النموذج ' Cancel = Not Permission_OpenForm(Me.Name, True) ' ' تطبيق صلاحيات : الإضافة / التعديل / الحذف ' Apply_Addition_Edits_Delete_Permissions (Me.Name) 'End Sub '------------------------------------------------------------------------------- ' (2) : لتطبيق صلاحيات الطباعة والاستيراد والتصدير داخل نموذج معين تكتب هذه الأسطر لمعرفة وجود الصلاحة من عدمها ' : وكل سطر من هذه الصلاحيات يرجع لك النتيجة كما يلي ' True : مسموح ' False : ممنوع '------------------------------------------------------------------------------- ' 1- فحص صلاحية الطباعة (True/False) ' Permission_Print(Me.Name , True) ' |_>> (True/False) : هذه الجزئية اختيارية لعرض رسالة تنبيه عند عدم وجود صلاحية من عدمها ' 2- فحص صلاحية الاستيراد (True/False) ' Permission_Import(Me.Name , True) ' |_>> (True/False) : هذه الجزئية اختيارية لعرض رسالة تنبيه عند عدم وجود صلاحية من عدمها ' 3- فحص صلاحية التصدير (True/False) ' Permission_Export(Me.Name , True) ' |_>> (True/False) : هذه الجزئية اختيارية لعرض رسالة تنبيه عند عدم وجود صلاحية من عدمها '------------------------------------------------------------------------------- والنماذج الموجودة في البرنامج مع أزرارها تم تطبيق الأكواد عليها بشكل عملي << راجعها وأدرسها لمعرفة كيفية عملها .. وهي سهلة يسيرة بفضل الله 🙂 وهذا مثال عملي لتطبيق الصلاحية على زر الطباعة (فتح التقرير) مثلا : وهكذا بقية الصلاحيات (اطلع على بقية الموديول) تم تحويلها لأسطر قليلة بسيطة للاستفادة منها بكل يسر .. 🙂 :: 🌹 وآخر دعوانا أن الحمد لله رب العالمين 🌹 :: صاحب الملف Moosak تمت الاضافه 05/12/26 الاقسام قسم الأكسيس  

السلام عليكم الموقع https://zingl.github.io يعرض طريقة لعمل الباركود Code128, QR, Aztec, DataMatrix بالكود ويدون الاستعانة ببرامج خارجية. في الموقع مرفق اكسس (وقد عملت تعديل بسيط عليه لعمل الصور التالية ، والمرفق موجود في اسفل المشاركة) ، وهنا اعرض مثالين على العرض: . . طبعا Code128 غير مناسب للكلمات الطويلة. الكود يقوم بعرض الباركود داخل حقل نص Textbox ، وهو يستعمل Line لعمل الباركود : . المشكلة ان الاكسس يقوم بتنفيذ الامر Line على خلفية التقرير/النموذج ، وبعدها يقوم بعرض بقية الكائنات ، بمعنى ، اذا وضعنا كائن/حقل صورة خلف حقل نص الباركود ، فاننا لا نستطيع رؤية الباركود ، لأنه اصبح خلف الصورة. في الصورة التالية ، التقرير الاول هو ما تم عرضه سابقا ، بينما في التقرير الثاني وضعت صورة زرقاء خلف كائنات/حقول الباركود: . ونتيجة التقرير الثاني: . مع وجود الصورة في الخلف ، المطلوب اظهار الباركود على الصورة ، وبأي طريقة. من تجربتي ، لإظهار الباركود ، يجب وضعه في كائن/حقل صورة ، امام الصورة الخلفية. ارفق لكم من نفس الموقع ، مرفق اكسل كذلك. ومن موقع www.lebans.com ارفق قاعدة البيانات A2KPictureBoxVer35.accdb ، والتي بها نموذج و مكتبات قد تساعد الذكاء الاصطناعي بالعمل (نعم ، قد يحتاج الى مساعدتك في توجيهه). QR_barcode.accdb A2KPictureBoxVer35.accdb barcode.xlsm

في مساء يوم ، جاءني ضيف لحوح اسمه ( الملل ) ، وجلسنا نتسامر ونتحاور ونتشاور ، حتى خرجنا بالفكرة الموضحة في الصورة التالية :- وفي الحقيقة أطمع بأن يشاركني أحد أفكار أضيفها للعمل ، مع العلم أن العمل كاملاً مصمم في نموذج آكسيس واحد حالياً . وكما ترون في الصورة وهي تجسيد للعبة الثعبان التي كثير منا قد تسللت أنامله لها سابقاً ممن استخدموا هواتف نوكيا قديماً .. ولهذا أبحث عن أفكار أضيفها للتنفيذ بشكل عام وليس في التصميم فقط . سيتم طرح لعبة الثعبان كما لم تعرفوها من قبل وشكراً لكل من شارك أو مر من هنا

السلام عليكم ورحمة الله وبركاته .. 🙂 نزولا عند رغبة شيخنا الفاضل @ابوخليل تم إضافة تحسين بسيط على دالة التفقيط المبسطة لتعميم الفائدة .. طبعا الدالة كانت تأخذ 3 أرقام من كسر العملة هكذا ( 143.487 ) وهذا ينطبق على بعض العملات كالريال العماني والبيسة العمانية بينما أن هناك الكثير من العملات تعتمد 2 رقمين لكسر العملة مثال الريال والهللة السعودية والجنيه والقرش المصري هكذا ( 123.45 ) والتعديل الذي تم إجراؤه هو إضافة معامل رابع للدالة للتحكم في هذا الاختلاف واختيار عدد أرقام كسر العملة 2 أو 3 حسب الحاجة .. بدون إطالة إليكم الدالة كاملة .. وكذلك تم إضافة ملف جاهز ليبين طريقة الاستخدام : 🙂 Option Compare Database Option Explicit Function NoToTxt(TheNo As Double, _ MyCur As String, _ MySubCur As String, _ Optional FractionDigits As Integer = 3 _ ) As String '---------------------------------- ' دالة التفقيط المحسنة ' TheNo : المبلغ ' MyCur : العملة الرئيسية ' MySubCur : جزء العملة ' FractionDigits : عدد أرقام جزء العملة 2 أو 3 '---------------------------------- ' : أمثلة على الاستخدام ' NoToTxt(15.436, "ريال عماني", "بيسة") ' NoToTxt(15.43, "ريال", "هللة", 2 ) ' NoToTxt2(15.436, "ريال", "بيسة", 3) '---------------------------------- Dim MyArry1(0 To 9) As String Dim MyArry2(0 To 9) As String Dim MyArry3(0 To 9) As String Dim Myno As String Dim GetNo As String Dim RdNo As Integer Dim My100 As String Dim My10 As String Dim My1 As String Dim My11 As String Dim My12 As String Dim GetTxt As String Dim Mybillion As String Dim MyMillion As String Dim MyThou As String Dim MyHun As String Dim MyFraction As String Dim MyAnd As String Dim i As Integer Dim ReMark As String Dim IntegerPart As Double Dim FractionPart As Long Dim ScaleNo As Double ' عدد خانات الكسر المسموح بها ' الدالة الحالية تقرأ الجزء العشري كمجموعة من 3 أرقام، لذلك الحد الأعلى 3 If FractionDigits < 0 Then FractionDigits = 0 If FractionDigits > 3 Then FractionDigits = 3 If Abs(TheNo) > 999999999999.999 Then Exit Function If TheNo < 0 Then TheNo = TheNo * -1 ReMark = "عليه مبلغ " Else ReMark = "له مبلغ " End If If TheNo = 0 Then NoToTxt = "صفر" Exit Function End If MyAnd = " و" MyArry1(0) = "" MyArry1(1) = "مائة" MyArry1(2) = "مائتان" MyArry1(3) = "ثلاثمائة" MyArry1(4) = "اربعمائة" MyArry1(5) = "خمسمائة" MyArry1(6) = "ستمائة" MyArry1(7) = "سبعمائة" MyArry1(8) = "ثمانمائة" MyArry1(9) = "تسعمائة" MyArry2(0) = "" MyArry2(1) = " عشر" MyArry2(2) = "عشرون" MyArry2(3) = "ثلاثون" MyArry2(4) = "اربعون" MyArry2(5) = "خمسون" MyArry2(6) = "ستون" MyArry2(7) = "سبعون" MyArry2(8) = "ثمانون" MyArry2(9) = "تسعون" MyArry3(0) = "" MyArry3(1) = "احدى" MyArry3(2) = "اثنان" MyArry3(3) = "ثلاثة" MyArry3(4) = "اربعة" MyArry3(5) = "خمسة" MyArry3(6) = "ستة" MyArry3(7) = "سبعة" MyArry3(8) = "ثمانية" MyArry3(9) = "تسعة" '====================== ' تجهيز الرقم حسب عدد الخانات المطلوبة بعد الفاصلة ' مثال: ' FractionDigits = 2 يجعل 15.436 تقرأ كـ 15.44 ' FractionDigits = 3 يجعل 15.436 تقرأ كـ 15.436 TheNo = Round(TheNo, FractionDigits) IntegerPart = Fix(TheNo) If FractionDigits = 0 Then FractionPart = 0 Else ScaleNo = 10 ^ FractionDigits FractionPart = CLng(Round((TheNo - IntegerPart) * ScaleNo, 0)) End If ' معالجة حالة التقريب التي قد ترفع الجزء العشري إلى 100 أو 1000 If FractionDigits > 0 Then If FractionPart >= ScaleNo Then IntegerPart = IntegerPart + 1 FractionPart = 0 End If End If ' الجزء الصحيح 12 رقم + الجزء العشري دائمًا 3 أرقام داخليًا ' عند اختيار خانتين مثلًا 44 يتم تخزينها كـ 044 حتى تُقرأ أربعون وأربعة GetNo = Format(IntegerPart, "000000000000") & "." & Format(FractionPart, "000") i = 0 '=============== Do While i < 16 My100 = "" My10 = "" My1 = "" My11 = "" My12 = "" GetTxt = "" If i < 12 Then Myno = Mid$(GetNo, i + 1, 3) Else Myno = Mid$(GetNo, i + 2, 3) End If If Val(Mid$(Myno, 1, 3)) > 0 Then RdNo = Val(Mid$(Myno, 1, 1)) My100 = MyArry1(RdNo) RdNo = Val(Mid$(Myno, 3, 1)) My1 = MyArry3(RdNo) RdNo = Val(Mid$(Myno, 2, 1)) My10 = MyArry2(RdNo) If Val(Mid$(Myno, 2, 2)) = 11 Then My11 = "احدى عشر" If Val(Mid$(Myno, 2, 2)) = 12 Then My12 = "اثني عشر" If Val(Mid$(Myno, 2, 2)) = 10 Then My10 = "عشرة" If Val(Mid$(Myno, 1, 1)) > 0 And Val(Mid$(Myno, 2, 2)) > 0 Then My100 = My100 & MyAnd End If If Val(Mid$(Myno, 3, 1)) > 0 And Val(Mid$(Myno, 2, 1)) > 1 Then My1 = My1 & MyAnd End If GetTxt = My100 & My1 & My10 If Val(Mid$(Myno, 3, 1)) = 1 And Val(Mid$(Myno, 2, 1)) = 1 Then GetTxt = My100 & My11 If Val(Mid$(Myno, 1, 1)) = 0 Then GetTxt = My11 End If If Val(Mid$(Myno, 3, 1)) = 2 And Val(Mid$(Myno, 2, 1)) = 1 Then GetTxt = My100 & My12 If Val(Mid$(Myno, 1, 1)) = 0 Then GetTxt = My12 End If If i = 0 And GetTxt <> "" Then If Val(Mid$(Myno, 1, 3)) > 10 Then Mybillion = GetTxt & " مليار" Else Mybillion = GetTxt & " مليارات" If Val(Mid$(Myno, 1, 3)) = 1 Then Mybillion = " مليار" If Val(Mid$(Myno, 1, 3)) = 2 Then Mybillion = " ملياران" End If End If If i = 3 And GetTxt <> "" Then If Val(Mid$(Myno, 1, 3)) > 10 Then MyMillion = GetTxt & " مليون" Else MyMillion = GetTxt & " ملايين" If Val(Mid$(Myno, 1, 3)) = 1 Then MyMillion = " مليون" If Val(Mid$(Myno, 1, 3)) = 2 Then MyMillion = " مليونان" End If End If If i = 6 And GetTxt <> "" Then If Val(Mid$(Myno, 1, 3)) > 10 Then MyThou = GetTxt & " الف" Else MyThou = GetTxt & " الاف" If Val(Mid$(Myno, 1, 3)) = 1 Then MyThou = " الف" If Val(Mid$(Myno, 1, 3)) = 2 Then MyThou = " الفان" End If End If If i = 9 And GetTxt <> "" Then MyHun = GetTxt If i = 12 And GetTxt <> "" Then If FractionDigits > 0 Then MyFraction = GetTxt End If End If End If i = i + 3 Loop '============================ If Mybillion <> "" Then If MyMillion <> "" Or MyThou <> "" Or MyHun <> "" Then Mybillion = Mybillion & MyAnd End If End If If MyMillion <> "" Then If MyThou <> "" Or MyHun <> "" Then MyMillion = MyMillion & MyAnd End If End If If MyThou <> "" Then If MyHun <> "" Then MyThou = MyThou & MyAnd End If End If If MyFraction <> "" Then If Mybillion <> "" Or MyMillion <> "" Or MyThou <> "" Or MyHun <> "" Then NoToTxt = ReMark & Mybillion & MyMillion & MyThou & MyHun & " " & MyCur & MyAnd & MyFraction & " " & MySubCur & " فقط" Else NoToTxt = ReMark & MyFraction & " " & MySubCur & " فقط" End If Else NoToTxt = ReMark & Mybillion & MyMillion & MyThou & MyHun & " " & MyCur & " فقط" End If End Function NoToTxt.accdb

و عليكم السلام ورحمة الله وبركاته تفضل الملف حسب نسخة الأوفيس عندك لو قديم الملف الأول و لكن اذا أضفت كلمات جديدة يجب أن تضيفها في الصيغة ولو عندك . أوفيس حديث يمكن استخدام الملف الثاني فهو يتعرف على الكلمات تلقائيا الملف الثالث يعمل بالأكواد الحضور والغياب (2).xlsx الحضور والغياب حديث.xlsx الحضور والغياب أكواد.xlsm

اعرض الملف UiMsg Framework - نظام رسائل احترافي استبدال صندوق الرسائل فى الاكسس بنموذج رسائل احترافى بسطر واحد بس كل حاجة جاهزة مش محتاج تفكر في تصميم نموذج مش محتاج نموذج الرسائل يكون موجود اساسا مش محتاج تكتب كود كبير بعد كده لصندوق الرسائل استدعي الدالة وخلاص والنظام يعمل كل شئ النظام يقدم 4 أنواع رسائل جاهزة : { معلومة - نجاح - تحذير - خطأ } كل نوع بتصميمه ولونه وأيقونته معلومة : من خلال : UiInfo اللون : أزرق نجاح : من خلال : UiSuccess اللون : أخضر تحذير : من خلال : UiWarning اللون : برتقالي خطأ : من خلال : UiError اللون : أحمر 3 أنواع إدخال : { نص حر - رقم مع تحقق تلقائي - اختيار من قائمة } نص حر : من خلال : UiInput رقم مع تحقق تلقائي: من خلال : UiInputNum يرفض الحروف بدون ما تكتب سطر واحد اختيار من قائمة : من خلال : UiPick قرارات متعددة : { تأكيد نعم/لا - ثلاثة خيارات أزرار مخصصة بأسماء ترجعها النتيجة مباشرة } نعم / لا : من خلال : BlnUiConfirm يرجع True أو False مباشرة ثلاثة خيارات : من خلال :IntUiConfirm3 يرجع 1 أو 2 أو 0 أزرار مخصصة : من خلال :UiCustom يرجع اسم الزر اللي اتضغط مش رقمه دعم كامل للعربية والإنجليزية : { اتجاه النص RTL/LTR تلقائي - الأزرار والعناوين بالغتين من خلال معامل UiLangEn يكفي لتبديل كل شيء } أضف UiLangEn كآخر parameter وكل شيء يتبدل : اتجاه النص - الأزرار - العناوين الافتراضية ثيم موحد قابل للتخصيص : { ألوان الهيدر والأيقونات والأزرار كلها من UiTheme غير لون الـ Accent في مكان واحد وكل الرسائل تتغير } كل ألوان النظام مجمعة في UiTheme مناسب لأي مشروع قاعدة بيانات صغير أو كبير - عربي أو إنجليزي - مبتدئ أو محترف يبني نفسه : لا تثبيت ولا إعداد كل إجراء أو وظيفة واضحة الاسم - واضحة الـ return - واضحة الاستخدام اسم الوحدة النمطية : modUIMsgFramework كود الوحدة النمطية.. Option Explicit Option Compare Database Public Enum UiIcon UiIconInfo = 0 UiIconSuccess = 1 UiIconWarning = 2 UiIconError = 3 UiIconQuestion = 4 End Enum Public Enum UiMode UiModeAlert = 0 UiModeInput = 1 UiModeNumber = 2 UiModeList = 3 End Enum Public Enum UiLang UiLangAr = 0 UiLangEn = 1 End Enum Public Type UiParams strMessage As String strTitle As String strButtons As String strDefault As String strList As String strDetails As String strResult As String enuIcon As UiIcon enuMode As UiMode enuLang As UiLang End Type Public Type UiTheme lngAccent As Long lngHeader As Long lngBg As Long lngText As Long lngMuted As Long lngBorder As Long lngSuccess As Long lngWarning As Long lngError As Long lngInfo As Long lngQuestion As Long End Type Private Const STRFORMNAME As String = "frmUiMsg" Private Const STRMODNAME As String = "modUICore" Private Const MAX_BUTTONS As Integer = 5 Private Const FRM_W As Long = 9000 Private m_typParams As UiParams Public Function TypDefaultTheme() As UiTheme Dim typT As UiTheme typT.lngAccent = RGB(0, 120, 212) typT.lngHeader = RGB(32, 32, 38) typT.lngBg = RGB(245, 246, 250) typT.lngText = RGB(30, 30, 35) typT.lngMuted = RGB(120, 120, 130) typT.lngBorder = RGB(210, 212, 220) typT.lngSuccess = RGB(16, 124, 16) typT.lngWarning = RGB(200, 100, 0) typT.lngError = RGB(196, 43, 28) typT.lngInfo = RGB(0, 120, 212) typT.lngQuestion = RGB(104, 33, 122) TypDefaultTheme = typT End Function Private Function BlnFormExists(ByVal strName As String) As Boolean On Error Resume Next Dim objFrm As Object Set objFrm = CurrentProject.AllForms(strName) BlnFormExists = Not (objFrm Is Nothing) Set objFrm = Nothing On Error GoTo 0 End Function Private Sub LogError(ByVal strProc As String, _ ByVal lngNum As Long, _ ByVal strDesc As String) Debug.Print "[" & STRMODNAME & "." & strProc & "] " & _ "Err " & lngNum & ": " & strDesc & _ " @ " & Now() End Sub Public Function TypGetParams() As UiParams TypGetParams = m_typParams End Function Public Sub SetResult(ByVal strResult As String) m_typParams.strResult = strResult End Sub Private Sub ResetParams() Dim typEmpty As UiParams m_typParams = typEmpty End Sub Private Function StrDefaultTitle(ByVal enuIcon As UiIcon, _ ByVal enuLang As UiLang) As String If enuLang = UiLangAr Then Select Case enuIcon Case UiIconSuccess: StrDefaultTitle = "تم بنجاح" Case UiIconWarning: StrDefaultTitle = "تحذير" Case UiIconError: StrDefaultTitle = "خطأ" Case UiIconQuestion: StrDefaultTitle = "تأكيد" Case Else: StrDefaultTitle = "معلومة" End Select Else Select Case enuIcon Case UiIconSuccess: StrDefaultTitle = "Success" Case UiIconWarning: StrDefaultTitle = "Warning" Case UiIconError: StrDefaultTitle = "Error" Case UiIconQuestion: StrDefaultTitle = "Confirm" Case Else: StrDefaultTitle = "Information" End Select End If End Function Private Function StrValidateButtons(ByVal strBtns As String) As String Dim arrB() As String Dim intCnt As Integer Dim intI As Integer Dim strOut As String arrB = Split(strBtns, ",") intCnt = UBound(arrB) + 1 If intCnt > MAX_BUTTONS Then LogError "StrValidateButtons", 0, _ "تجاوز الحد الأقصى للأزرار (" & intCnt & "). سيتم اقتصارها على " & MAX_BUTTONS intCnt = MAX_BUTTONS End If For intI = 0 To intCnt - 1 If Len(strOut) > 0 Then strOut = strOut & "," strOut = strOut & Trim(arrB(intI)) Next intI StrValidateButtons = strOut End Function Private Function BlnBuildMsgForm() As Boolean On Error GoTo ErrHandler Dim typT As UiTheme Dim objFrm As Object Dim objCtl As Object Dim strTemp As String Dim intI As Integer Dim lngLeft As Long typT = TypDefaultTheme() Const HDR_H As Long = 900 Const ICON_L As Long = 200 Const ICON_T As Long = 150 Const ICON_W As Long = 600 Const ICON_H As Long = 600 Const TITLE_L As Long = 900 Const TITLE_T As Long = 200 Const TITLE_W As Long = 7800 Const TITLE_H As Long = 500 Const MSG_L As Long = 300 Const MSG_T As Long = 1050 Const MSG_W As Long = 8400 Const MSG_H As Long = 1400 Const DET_L As Long = 300 Const DET_T As Long = 2500 Const DET_W As Long = 8400 Const DET_H As Long = 700 Const INP_L As Long = 300 Const INP_T As Long = 3300 Const INP_W As Long = 8400 Const INP_H As Long = 450 Const DIV_T As Long = 4050 Const BTN_T As Long = 4250 Const BTN_W As Long = 1550 Const BTN_H As Long = 550 Const FRM_H As Long = 5000 Set objFrm = CreateForm strTemp = objFrm.Name With objFrm .Caption = "" .ScrollBars = 0 .RecordSelectors = False .NavigationButtons = False .DividingLines = False .BorderStyle = 1 .AutoCenter = True .PopUp = True .Modal = True .Width = FRM_W .Section(0).Height = FRM_H .Section(0).BackColor = typT.lngBg End With Set objCtl = CreateControl(strTemp, acRectangle, acDetail) With objCtl .Name = "recHeader": .Left = 0: .Top = 0 .Width = FRM_W: .Height = HDR_H .BackColor = typT.lngHeader: .BackStyle = 1 .BorderStyle = 0: .SpecialEffect = 0 End With Set objCtl = CreateControl(strTemp, acRectangle, acDetail) With objCtl .Name = "recIcon": .Left = ICON_L: .Top = ICON_T .Width = ICON_W: .Height = ICON_H .BackColor = typT.lngInfo: .BackStyle = 1 .BorderStyle = 0: .SpecialEffect = 0 End With Set objCtl = CreateControl(strTemp, acLabel, acDetail) With objCtl .Name = "lblIcon": .Caption = "i" .Left = ICON_L: .Top = ICON_T .Width = ICON_W: .Height = ICON_H .FontSize = 20: .FontBold = True .ForeColor = vbWhite: .BackStyle = 0: .TextAlign = 2 End With Set objCtl = CreateControl(strTemp, acLabel, acDetail) With objCtl .Name = "lblTitle": .Caption = "" .Left = TITLE_L: .Top = TITLE_T .Width = TITLE_W: .Height = TITLE_H .FontSize = 14: .FontBold = True .ForeColor = vbWhite: .BackStyle = 0: .TextAlign = 1 End With Set objCtl = CreateControl(strTemp, acLabel, acDetail) With objCtl .Name = "lblMessage": .Caption = "" .Left = MSG_L: .Top = MSG_T .Width = MSG_W: .Height = MSG_H .FontSize = 11: .ForeColor = typT.lngText .BackStyle = 0: .TextAlign = 1 End With Set objCtl = CreateControl(strTemp, acLabel, acDetail) With objCtl .Name = "lblDetails": .Caption = "" .Left = DET_L: .Top = DET_T .Width = DET_W: .Height = DET_H .FontSize = 9: .ForeColor = typT.lngMuted .BackStyle = 0: .Visible = False End With Set objCtl = CreateControl(strTemp, acTextBox, acDetail) With objCtl .Name = "txtInput" .Left = INP_L: .Top = INP_T .Width = INP_W: .Height = INP_H .FontSize = 11 .BorderColor = typT.lngBorder: .BackColor = vbWhite .Visible = False End With Set objCtl = CreateControl(strTemp, acComboBox, acDetail) With objCtl .Name = "cboList" .Left = INP_L: .Top = INP_T .Width = INP_W: .Height = INP_H .FontSize = 11 .BorderColor = typT.lngBorder: .BackColor = vbWhite .RowSourceType = "Value List" .LimitToList = True: .AllowValueListEdits = False .Visible = False End With Set objCtl = CreateControl(strTemp, acLine, acDetail) With objCtl .Name = "linDivider": .Left = 0: .Top = DIV_T .Width = FRM_W: .Height = 0 .BorderColor = typT.lngBorder: .BorderWidth = 1 End With For intI = 1 To MAX_BUTTONS lngLeft = 200 + ((intI - 1) * 1760) Set objCtl = CreateControl(strTemp, acCommandButton, acDetail) With objCtl .Name = "btn" & intI: .Caption = "btn" & intI .Left = lngLeft: .Top = BTN_T .Width = BTN_W: .Height = BTN_H .FontSize = 10: .FontBold = True .BackColor = typT.lngAccent: .ForeColor = vbWhite .BorderStyle = 0: .Visible = False .OnClick = "=ProcBtnClick(" & intI & ")" End With Next intI DoCmd.Save acForm, strTemp DoCmd.Close acForm, strTemp, acSaveYes DoCmd.Rename STRFORMNAME, acForm, strTemp BlnBuildMsgForm = True Set objCtl = Nothing: Set objFrm = Nothing Exit Function ErrHandler: LogError "BlnBuildMsgForm", Err.Number, Err.Description BlnBuildMsgForm = False Set objCtl = Nothing: Set objFrm = Nothing End Function Private Function BlnInjectMsgCode() As Boolean On Error GoTo ErrHandler Dim objMdl As Object Dim strCode As String Dim strOldCode As String DoCmd.OpenForm STRFORMNAME, acDesign, , , , acHidden Set objMdl = Forms(STRFORMNAME).Module If objMdl.CountOfLines > 0 Then strOldCode = objMdl.Lines(1, objMdl.CountOfLines) objMdl.DeleteLines 1, objMdl.CountOfLines End If strCode = StrFormCodeHeader() & _ StrFormCodeApplyIcon() & _ StrFormCodeApplyLang() & _ StrFormCodeSetupBtns() & _ StrFormCodeFillList() & _ StrFormCodeOpen() & _ StrFormCodeBtn() & _ StrFormCodeUnload() objMdl.AddFromString strCode If objMdl.CountOfLines < 10 Then If Len(strOldCode) > 0 Then objMdl.DeleteLines 1, objMdl.CountOfLines objMdl.AddFromString strOldCode End If LogError "BlnInjectMsgCode", 0, "AddFromString أنتج كوداً فارغاً، تم استعادة الكود القديم" BlnInjectMsgCode = False GoTo Cleanup End If DoCmd.Save acForm, STRFORMNAME DoCmd.Close acForm, STRFORMNAME, acSaveYes BlnInjectMsgCode = True Cleanup: Set objMdl = Nothing Exit Function ErrHandler: LogError "BlnInjectMsgCode", Err.Number, Err.Description BlnInjectMsgCode = False Set objMdl = Nothing End Function Private Function StrFormCodeHeader() As String Dim s As String s = "Option Explicit" & vbCrLf s = s & "Option Compare Database" & vbCrLf & vbCrLf s = s & "Private mintMode As Integer" & vbCrLf s = s & "Private mintLang As Integer" & vbCrLf & vbCrLf StrFormCodeHeader = s End Function Private Function StrFormCodeApplyIcon() As String Dim s As String s = "Private Sub ProcApplyIcon(ByVal intIcon As Integer)" & vbCrLf s = s & " Select Case intIcon" & vbCrLf s = s & " Case 1" & vbCrLf s = s & " Me.recHeader.BackColor = RGB(16,124,16)" & vbCrLf s = s & " Me.recIcon.BackColor = RGB(16,124,16)" & vbCrLf s = s & " Me.lblIcon.Caption = Chr(252)" & vbCrLf s = s & " Me.lblIcon.FontName = ""Wingdings""" & vbCrLf s = s & " Case 2" & vbCrLf s = s & " Me.recHeader.BackColor = RGB(200,100,0)" & vbCrLf s = s & " Me.recIcon.BackColor = RGB(200,100,0)" & vbCrLf s = s & " Me.lblIcon.Caption = Chr(56)" & vbCrLf s = s & " Me.lblIcon.FontName = ""Wingdings""" & vbCrLf s = s & " Case 3" & vbCrLf s = s & " Me.recHeader.BackColor = RGB(196,43,28)" & vbCrLf s = s & " Me.recIcon.BackColor = RGB(196,43,28)" & vbCrLf s = s & " Me.lblIcon.Caption = Chr(251)" & vbCrLf s = s & " Me.lblIcon.FontName = ""Wingdings""" & vbCrLf s = s & " Case 4" & vbCrLf s = s & " Me.recHeader.BackColor = RGB(104,33,122)" & vbCrLf s = s & " Me.recIcon.BackColor = RGB(104,33,122)" & vbCrLf s = s & " Me.lblIcon.Caption = Chr(63)" & vbCrLf s = s & " Me.lblIcon.FontName = ""Wingdings""" & vbCrLf s = s & " Case Else" & vbCrLf s = s & " Me.recHeader.BackColor = RGB(0,120,212)" & vbCrLf s = s & " Me.recIcon.BackColor = RGB(0,120,212)" & vbCrLf s = s & " Me.lblIcon.Caption = Chr(105)" & vbCrLf s = s & " Me.lblIcon.FontName = ""Arial""" & vbCrLf s = s & " End Select" & vbCrLf s = s & "End Sub" & vbCrLf & vbCrLf StrFormCodeApplyIcon = s End Function Private Function StrFormCodeApplyLang() As String Dim s As String s = "Private Sub ProcApplyLang(ByVal intLang As Integer)" & vbCrLf s = s & " Dim intAlign As Integer" & vbCrLf s = s & " intAlign = IIf(intLang = 0, 3, 1)" & vbCrLf s = s & " Me.lblTitle.TextAlign = intAlign" & vbCrLf s = s & " Me.lblMessage.TextAlign = intAlign" & vbCrLf s = s & " Me.lblDetails.TextAlign = intAlign" & vbCrLf s = s & " Me.txtInput.TextAlign = intAlign" & vbCrLf s = s & " Me.cboList.TextAlign = intAlign" & vbCrLf s = s & "End Sub" & vbCrLf & vbCrLf StrFormCodeApplyLang = s End Function Private Function StrFormCodeSetupBtns() As String Dim s As String s = "Private Sub ProcSetupBtns(ByVal strBtns As String, ByVal intLang As Integer)" & vbCrLf s = s & " Dim arrBtns() As String" & vbCrLf s = s & " Dim intTotal As Integer" & vbCrLf s = s & " Dim intI As Integer" & vbCrLf s = s & " Dim lngBtnW As Long" & vbCrLf s = s & " Dim lngBtnH As Long" & vbCrLf s = s & " Dim lngGap As Long" & vbCrLf s = s & " Dim lngTotalW As Long" & vbCrLf s = s & " Dim lngStartX As Long" & vbCrLf s = s & " Dim blnIsRtl As Boolean" & vbCrLf s = s & " arrBtns = Split(strBtns, "","")" & vbCrLf s = s & " intTotal = UBound(arrBtns) + 1" & vbCrLf s = s & " If intTotal > 5 Then intTotal = 5" & vbCrLf s = s & " blnIsRtl = (intLang = 0)" & vbCrLf s = s & " lngBtnW = 1550" & vbCrLf s = s & " lngBtnH = 550" & vbCrLf s = s & " lngGap = 200" & vbCrLf s = s & " lngTotalW = (intTotal * lngBtnW) + ((intTotal - 1) * lngGap)" & vbCrLf s = s & " lngStartX = (Me.Width - lngTotalW) \ 2" & vbCrLf s = s & " For intI = 1 To 5" & vbCrLf s = s & " Me(""btn"" & intI).Visible = False" & vbCrLf s = s & " Next intI" & vbCrLf s = s & " For intI = 1 To intTotal" & vbCrLf s = s & " With Me(""btn"" & intI)" & vbCrLf s = s & " .Caption = Trim(arrBtns(intI - 1))" & vbCrLf s = s & " If blnIsRtl Then" & vbCrLf s = s & " .Left = lngStartX + ((intTotal - intI) * (lngBtnW + lngGap))" & vbCrLf s = s & " Else" & vbCrLf s = s & " .Left = lngStartX + ((intI - 1) * (lngBtnW + lngGap))" & vbCrLf s = s & " End If" & vbCrLf s = s & " .Top = 4250: .Width = lngBtnW: .Height = lngBtnH" & vbCrLf s = s & " .Visible = True" & vbCrLf s = s & " End With" & vbCrLf s = s & " Next intI" & vbCrLf s = s & "End Sub" & vbCrLf & vbCrLf StrFormCodeSetupBtns = s End Function Private Function StrFormCodeFillList() As String Dim s As String s = "Private Sub ProcFillList(ByVal strItems As String, ByVal strDefault As String)" & vbCrLf s = s & " Dim arrItems() As String" & vbCrLf s = s & " Dim strSource As String" & vbCrLf s = s & " Dim intI As Integer" & vbCrLf s = s & " arrItems = Split(strItems, "","")" & vbCrLf s = s & " For intI = 0 To UBound(arrItems)" & vbCrLf s = s & " strSource = strSource & Trim(arrItems(intI)) & "";""" & vbCrLf s = s & " Next intI" & vbCrLf s = s & " Me.cboList.RowSource = strSource" & vbCrLf s = s & " If Len(Trim(strDefault)) > 0 Then" & vbCrLf s = s & " Me.cboList.Value = strDefault" & vbCrLf s = s & " ElseIf UBound(arrItems) >= 0 Then" & vbCrLf s = s & " Me.cboList.Value = Trim(arrItems(0))" & vbCrLf s = s & " End If" & vbCrLf s = s & "End Sub" & vbCrLf & vbCrLf StrFormCodeFillList = s End Function Private Function StrFormCodeOpen() As String Dim s As String s = "Private Sub Form_Open(Cancel As Integer)" & vbCrLf s = s & " On Error GoTo ErrHandler" & vbCrLf s = s & " Dim typP As UiParams" & vbCrLf s = s & " typP = TypGetParams()" & vbCrLf s = s & " mintMode = CInt(typP.enuMode)" & vbCrLf s = s & " mintLang = CInt(typP.enuLang)" & vbCrLf s = s & " Me.Caption = typP.strTitle" & vbCrLf s = s & " Me.lblTitle.Caption = typP.strTitle" & vbCrLf s = s & " Me.lblMessage.Caption = typP.strMessage" & vbCrLf s = s & " Me.lblDetails.Visible = (Len(Trim(typP.strDetails)) > 0)" & vbCrLf s = s & " If Me.lblDetails.Visible Then Me.lblDetails.Caption = typP.strDetails" & vbCrLf s = s & " ProcApplyIcon CInt(typP.enuIcon)" & vbCrLf s = s & " ProcApplyLang mintLang" & vbCrLf s = s & " ProcSetupBtns typP.strButtons, mintLang" & vbCrLf s = s & " Me.txtInput.Visible = (mintMode = 1 Or mintMode = 2)" & vbCrLf s = s & " Me.cboList.Visible = (mintMode = 3)" & vbCrLf s = s & " If mintMode = 1 Or mintMode = 2 Then" & vbCrLf s = s & " Me.txtInput.Value = typP.strDefault" & vbCrLf s = s & " Me.txtInput.SetFocus" & vbCrLf s = s & " End If" & vbCrLf s = s & " If mintMode = 3 Then" & vbCrLf s = s & " ProcFillList typP.strList, typP.strDefault" & vbCrLf s = s & " Me.cboList.SetFocus" & vbCrLf s = s & " End If" & vbCrLf s = s & " Exit Sub" & vbCrLf s = s & "ErrHandler:" & vbCrLf s = s & " Debug.Print ""Form_Open Err: "" & Err.Number & "" - "" & Err.Description" & vbCrLf s = s & " DoCmd.Close acForm, Me.Name" & vbCrLf s = s & "End Sub" & vbCrLf & vbCrLf StrFormCodeOpen = s End Function Private Function StrFormCodeBtn() As String Dim s As String s = "Public Function ProcBtnClick(ByVal intNum As Integer)" & vbCrLf s = s & " On Error GoTo ErrHandler" & vbCrLf s = s & " Dim strResult As String" & vbCrLf s = s & " Dim strWarn As String" & vbCrLf s = s & " Select Case mintMode" & vbCrLf s = s & " Case 1" & vbCrLf s = s & " If intNum = 1 Then" & vbCrLf s = s & " strResult = Nz(Me.txtInput.Value, """")" & vbCrLf s = s & " Else" & vbCrLf s = s & " strResult = ""__CANCEL__""" & vbCrLf s = s & " End If" & vbCrLf s = s & " Case 2" & vbCrLf s = s & " If intNum = 1 Then" & vbCrLf s = s & " If Len(Nz(Me.txtInput.Value, """")) > 0 Then" & vbCrLf s = s & " If Not IsNumeric(Me.txtInput.Value) Then" & vbCrLf s = s & " strWarn = IIf(mintLang = 0, ""أدخل رقماً صحيحاً"", ""Enter a valid number"")" & vbCrLf s = s & " MsgBox strWarn, vbExclamation" & vbCrLf s = s & " Me.txtInput.SetFocus" & vbCrLf s = s & " Exit Function" & vbCrLf s = s & " End If" & vbCrLf s = s & " End If" & vbCrLf s = s & " strResult = Nz(Me.txtInput.Value, """")" & vbCrLf s = s & " Else" & vbCrLf s = s & " strResult = ""__CANCEL__""" & vbCrLf s = s & " End If" & vbCrLf s = s & " Case 3" & vbCrLf s = s & " If intNum = 1 Then" & vbCrLf s = s & " strResult = Nz(Me.cboList.Value, """")" & vbCrLf s = s & " Else" & vbCrLf s = s & " strResult = ""__CANCEL__""" & vbCrLf s = s & " End If" & vbCrLf s = s & " Case Else" & vbCrLf s = s & " strResult = Me(""btn"" & intNum).Caption" & vbCrLf s = s & " End Select" & vbCrLf s = s & " SetResult strResult" & vbCrLf s = s & " DoCmd.Close acForm, Me.Name" & vbCrLf s = s & " Exit Function" & vbCrLf s = s & "ErrHandler:" & vbCrLf s = s & " Debug.Print ""ProcBtnClick Err: "" & Err.Number & "" - "" & Err.Description" & vbCrLf s = s & "End Function" & vbCrLf & vbCrLf StrFormCodeBtn = s End Function Private Function StrFormCodeUnload() As String Dim s As String s = "Private Sub Form_Unload(Cancel As Integer)" & vbCrLf s = s & " Dim typP As UiParams" & vbCrLf s = s & " typP = TypGetParams()" & vbCrLf s = s & " If Len(Nz(typP.strResult, """")) = 0 Then" & vbCrLf s = s & " SetResult ""__CANCEL__""" & vbCrLf s = s & " End If" & vbCrLf s = s & "End Sub" & vbCrLf StrFormCodeUnload = s End Function Private Function BlnEnsureForm() As Boolean On Error GoTo ErrHandler If BlnFormExists(STRFORMNAME) Then BlnEnsureForm = True Exit Function End If If Not BlnBuildMsgForm() Then LogError "BlnEnsureForm", 0, "BlnBuildMsgForm failed" Exit Function End If If Not BlnInjectMsgCode() Then LogError "BlnEnsureForm", 0, "BlnInjectMsgCode failed" Exit Function End If BlnEnsureForm = True Exit Function ErrHandler: LogError "BlnEnsureForm", Err.Number, Err.Description BlnEnsureForm = False End Function Private Function StrShowMsg(ByVal strMsg As String, _ ByVal enuIcon As UiIcon, _ ByVal strBtns As String, _ ByVal strTitle As String, _ ByVal enuMode As UiMode, _ ByVal strDef As String, _ ByVal strList As String, _ ByVal strDet As String, _ ByVal enuLang As UiLang) As String On Error GoTo ErrHandler If Not BlnEnsureForm() Then LogError "StrShowMsg", 0, "EnsureForm failed" StrShowMsg = "__CANCEL__" Exit Function End If If Len(Trim(strTitle)) = 0 Then strTitle = StrDefaultTitle(enuIcon, enuLang) End If ResetParams With m_typParams .strMessage = strMsg .strTitle = strTitle .strButtons = StrValidateButtons(strBtns) .enuIcon = enuIcon .enuMode = enuMode .strDefault = strDef .strList = strList .strDetails = strDet .enuLang = enuLang .strResult = "" End With DoCmd.OpenForm STRFORMNAME, acNormal, , , , acDialog StrShowMsg = m_typParams.strResult If Len(StrShowMsg) = 0 Then StrShowMsg = "__CANCEL__" ResetParams Exit Function ErrHandler: LogError "StrShowMsg", Err.Number, Err.Description ResetParams StrShowMsg = "__CANCEL__" End Function Public Sub UiInfo(ByVal strMsg As String, _ Optional ByVal strTitle As String = "", _ Optional ByVal enuLang As UiLang = UiLangAr) Dim strBtns As String strBtns = IIf(enuLang = UiLangAr, "موافق", "OK") StrShowMsg strMsg, UiIconInfo, strBtns, strTitle, UiModeAlert, "", "", "", enuLang End Sub Public Sub UiSuccess(ByVal strMsg As String, _ Optional ByVal strTitle As String = "", _ Optional ByVal enuLang As UiLang = UiLangAr) Dim strBtns As String strBtns = IIf(enuLang = UiLangAr, "موافق", "OK") StrShowMsg strMsg, UiIconSuccess, strBtns, strTitle, UiModeAlert, "", "", "", enuLang End Sub Public Sub UiWarning(ByVal strMsg As String, _ Optional ByVal strTitle As String = "", _ Optional ByVal enuLang As UiLang = UiLangAr) Dim strBtns As String strBtns = IIf(enuLang = UiLangAr, "موافق", "OK") StrShowMsg strMsg, UiIconWarning, strBtns, strTitle, UiModeAlert, "", "", "", enuLang End Sub Public Sub UiError(ByVal strMsg As String, _ Optional ByVal strTitle As String = "", _ Optional ByVal strDetails As String = "", _ Optional ByVal enuLang As UiLang = UiLangAr) Dim strBtns As String strBtns = IIf(enuLang = UiLangAr, "موافق", "OK") StrShowMsg strMsg, UiIconError, strBtns, strTitle, UiModeAlert, "", "", strDetails, enuLang End Sub Public Function BlnUiConfirm(ByVal strMsg As String, _ Optional ByVal strTitle As String = "", _ Optional ByVal enuLang As UiLang = UiLangAr) As Boolean Dim strBtns As String Dim strYes As String Dim strResult As String strBtns = IIf(enuLang = UiLangAr, "نعم,لا", "Yes,No") strYes = IIf(enuLang = UiLangAr, "نعم", "Yes") strResult = StrShowMsg(strMsg, UiIconQuestion, strBtns, strTitle, UiModeAlert, "", "", "", enuLang) BlnUiConfirm = (strResult = strYes) End Function Public Function IntUiConfirm3(ByVal strMsg As String, _ Optional ByVal strTitle As String = "", _ Optional ByVal enuLang As UiLang = UiLangAr) As Integer Dim strBtns As String Dim strYes As String Dim strNo As String Dim strResult As String strBtns = IIf(enuLang = UiLangAr, "نعم,لا,إلغاء", "Yes,No,Cancel") strYes = IIf(enuLang = UiLangAr, "نعم", "Yes") strNo = IIf(enuLang = UiLangAr, "لا", "No") strResult = StrShowMsg(strMsg, UiIconQuestion, strBtns, strTitle, UiModeAlert, "", "", "", enuLang) Select Case strResult Case strYes: IntUiConfirm3 = 1 Case strNo: IntUiConfirm3 = 2 Case Else: IntUiConfirm3 = 0 End Select End Function Public Function UiInput(ByVal strMsg As String, _ Optional ByVal strTitle As String = "", _ Optional ByVal strDefault As String = "", _ Optional ByVal enuLang As UiLang = UiLangAr) As String Dim strBtns As String Dim strResult As String strBtns = IIf(enuLang = UiLangAr, "موافق,إلغاء", "OK,Cancel") strResult = StrShowMsg(strMsg, UiIconInfo, strBtns, strTitle, UiModeInput, strDefault, "", "", enuLang) UiInput = IIf(strResult = "__CANCEL__", "", strResult) End Function Public Function UiInputNum(ByVal strMsg As String, _ Optional ByVal strTitle As String = "", _ Optional ByVal strDefault As String = "", _ Optional ByVal enuLang As UiLang = UiLangAr) As String Dim strBtns As String Dim strResult As String strBtns = IIf(enuLang = UiLangAr, "موافق,إلغاء", "OK,Cancel") strResult = StrShowMsg(strMsg, UiIconInfo, strBtns, strTitle, UiModeNumber, strDefault, "", "", enuLang) Select Case strResult Case "__CANCEL__", "": UiInputNum = "" Case Else UiInputNum = IIf(IsNumeric(strResult), strResult, "") End Select End Function Public Function UiPick(ByVal strMsg As String, _ ByVal strItems As String, _ Optional ByVal strTitle As String = "", _ Optional ByVal strDefault As String = "", _ Optional ByVal enuLang As UiLang = UiLangAr) As String Dim strBtns As String Dim strResult As String strBtns = IIf(enuLang = UiLangAr, "موافق,إلغاء", "OK,Cancel") strResult = StrShowMsg(strMsg, UiIconQuestion, strBtns, strTitle, UiModeList, strDefault, strItems, "", enuLang) UiPick = IIf(strResult = "__CANCEL__", "", strResult) End Function Public Function UiCustom(ByVal strMsg As String, _ ByVal strBtns As String, _ Optional ByVal enuIcon As UiIcon = UiIconQuestion, _ Optional ByVal strTitle As String = "", _ Optional ByVal enuLang As UiLang = UiLangAr) As String Dim strResult As String strResult = StrShowMsg(strMsg, enuIcon, strBtns, strTitle, UiModeAlert, "", "", "", enuLang) UiCustom = IIf(strResult = "__CANCEL__", "", strResult) End Function ' ===================================== ' أمثلة الاستخدام ' ===================================== ' UiSuccess "تم انشاء النظام بنجاح" ' UiInfo "رسالة معلومة" ' UiWarning "تحذير: لا يمكن التراجع" ' UiError "حدث خطأ", "", "تفاصيل الخطأ" ' ' If BlnUiConfirm("هل تريد الحذف؟") Then ... ' ' Select Case IntUiConfirm3("حفظ التغييرات؟") ' Case 1: ' نعم ' Case 2: ' لا ' Case 0: ' إلغاء ' End Select ' ' Dim s As String ' s = StrUiInput("أدخل اسمك", "", "محمد") ' If Len(s) > 0 Then ... ' ' Dim n As String ' n = StrUiInputNum("أدخل العمر", "", "25") ' ' Dim pick As String ' pick = StrUiPick("اختر قسم", "مبيعات,محاسبة,مخازن,إدارة") ' ' Dim choice As String ' choice = StrUiCustom("اختر خيار", "حفظ,تجاهل,إلغاء") ' Select Case choice ' Case "حفظ": ... ' Case "تجاهل": ... ' Case "": ' أُغلق بدون اختيار ' End Select طريقة الاعداد و التشغيل : بعد اضافة الوحدة النمطية: modUIMsgFramework الى قاعدة بياناتك استدعي من أي زر أمر داخل أى نموذج أو من النافذة الفورية مباشرة UiSuccess "تم انشاء النظام بنجاح" للتجربة الفورية فى المرفق تم اضافة ما يلى : وحدة نمطية باسم : modBuildTestUI ماكرو باسم : BuildTestUI شغل الماكرو BuildTestUI على الفور هيتم عمل جدول tblEmployees يحتوى على بيانات افتراضية غير حقيقية للتجربة وهيتم عمل نموذج اختبار متكامل وفتحة بشكل مباشر صاحب الملف عسل قليل الدسم تمت الاضافه 04/29/26 الاقسام قسم الأكسيس  

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

وعليكم السلام -تفضل معادلتين لطلبك .اختر منهما ما تشاء =MIN(IF(($C$7:$C$32=$M7)*($G$7:$G$32=""),$E$7:$E$32)) =MINIFS($E$7:$E$32,$C$7:$C$32,$M7,$G$7:$G$32,"") استخراج تاريخ اقدم الفاتورة-1.xlsx

السلام عليكم 🙂 كانت لنا تجربة في عمل لقاءات لأعضاء مجموعة الأكسس على الواتسأب وتم نشر الراوابط على مستوى أوسع .. وهذه روابط الللقاءات التي تمت : ولكن تم التوقف عنها لاحقا للأسف بسبب ضعف المشاركة والحضور .. 💔

بصراحة أنا رأيي مختلف فالطريقة الثانية سيكون التقرير فيها أخف لأنها لن تتطلب منك إنشاء تقرير إضافي وإضافة عنصر تحكم التقرير الفرعي هذا مثال لسيناريو محتمل سنفترض أن المطلوب تصميم تطبيق لإصدار البطائق وفق التصميم التالي عندها سنطلب ممن قام بتصميمها بإن يجعل منطقة الـ QRCode شفافة أو تحديدها كمربع 2×2 سم مثلا (للعلم انا قمت بهذه العملية بطريقة بدائية بإستخدام تطبيق Photos التابع لويندوز وستكون النتيجة أفضل إذا قام بها محترف فوتوشوب) قمت بإستخدام الصورة المعدلة فحصلت على النتيجة التالية ومرفق لكم المثال بعد التعديل تحياتي QR_barcode_New2.rar

وانا كذلك ما كانت عندي مشكلة. وللاجابة على السؤال وحسب ما قرأت : النماذج/التقارير المنبثقة ، ولأنه بإمكانك اخراجها من اطار برنامج الاكسس ، فيتعامل معها الوندوز ، وتأخذ الاتجاه حسب اتجاه اعدادات الوندوز ، يميناّ او يساراّ ، بينما النماذج ولأنها داخل اطار الاكسس ، فيتم التعامل معها بإعدادات الاكسس ، فتتوسط عرض النموذج. عملت هذه الحيلة: 1. جعلت النموذج بدون برواز . 2. اضفت كائن مسمى واسميته lbl_Move_Form ، ويمكنك تغيير اتجاهه حسب رغبتك . 3. استخدمت الكود التالي لتحريك النموذج ، بعد النقر على هذا الكائن Dim moveFrm As Boolean Dim xDrag As Long Dim yDrag As Long ' Private Sub lbl_Move_Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) moveFrm = True xDrag = X yDrag = Y End Sub Private Sub lbl_Move_Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) Dim xx As Long Dim yy As Long If moveFrm = True Then xx = Me.WindowLeft + X - xDrag yy = Me.WindowTop + Y - yDrag Me.Move xx, yy End If End Sub Private Sub lbl_Move_Form_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single) Dim xx As Long Dim yy As Long xx = Me.WindowLeft + X - xDrag yy = Me.WindowTop + Y - yDrag Me.Move xx, yy moveFrm = False End Sub . والنتيجة 1646.Form_Caption_Direction.mdb

السلام عليكم كما في العنوان حسابات جارية للأموال الواردة والمنصرف لشركة محددة وفروعها ضمن حساب موحد للشركة اما ان كانت حاجتك مثل هذا ولكن تريد لكل فرع حسابه الخاص وقيود مزدوجة فستجد بغيتك هنا تحويلات من الصندوق واليه حساب الواردات حساب المصاريف تقرير تفصيلي حسب الطلب مجاميع وتفقيط رواتب الموظفين .. حسب الموظف الواحد وفرعه او حسب موظفي فرع او جميع موظفي الشركة ... فقط بضغطة زر مميزات البرنامج : 1- تقسيم قاعدة البيانات 2- اضافة شاشة دخول ومستخدمين الادمن كلمة المرور =78 البقية كلمة المرور =1 ولمسات اخرى وخصائص وخدمات تجدونها عند تصفح البرنامج المرفقات : النسخة الاولى .. يتبع تطوير AccUpPrg2.rar

لم أعرف أي التقريرين تريد تطبيق طلبك عليه ولكني رأيت أن تقرير (مناداة قديم) هو الاقرب فقمت بتنفيذ الحل فيه ارجو أن يكون هذا الحل هو ماتريده بالضبط تحياتي 111.rar

السلام عليكم ورحمه الله وبركاته بعد اذن استاذنا @عبدالله بشير عبدالله ممكن تستخدم الملفات المرفقه للاضافه الدول عندك كيفية اضافة معادلة البحث XLOOKUP و الدالة Xmatch لاوفيس 2019-2016- 2010 - 2007 – 2003 XFunctions.7z

وعليكم السلام ورحمة الله وبركاته دالة XLOOKUP غير متوفرة في الإصدارات القديمة مثل Excel 2010 و2016 و2019، وهي موجودة فقط في Excel 2021 وما بعده، وكذلك في إصدارات Microsoft 365 احدى البدائل INDEX + MATCH

شاشة فريدة وحيدة exe التصميم على vb6 علما انه يوجد في مكتبتي نسخة من هذه الشاشة على اكسس .. ولكني ارى ان هذه اخف وتعمل على اي جهاز وهذا هو الكود المسؤول باستخدام المعادلة الطبية الظاهرة هذه المعادلة قد يستفيد منها من يريد اضافة هذه الميزة الى برنامجه الطبي Private Sub Command1_Click() On Error Resume Next Dim Dday As Integer Dim i As Double Dim sc As Integer Dim d1 As Date Dim s1 As String Dim m1 As Date 'Calendar = vbCalGreg i = DateDiff("d", Date, Text1.Text) w1.Text = Abs(i \ 7) dx.Text = Abs(i Mod 7) m1 = DateAdd("d", 280, Text1) Dday = Weekday(m1) If Dday = 1 Then yom.Text = "الأحد" If Dday = 2 Then yom.Text = "الاثنين" If Dday = 3 Then yom.Text = "الثلاثاء" If Dday = 4 Then yom.Text = "الأربعاء" If Dday = 5 Then yom.Text = "الخميس" If Dday = 6 Then yom.Text = "الجمعة" If Dday = 7 Then yom.Text = "السبت" 'Calendar = vbCalHijri h1 = Format(m1, "YYYY/MM/DD") End Sub حساب الحمل.rar

وعليكم السلام ورحمة الله وبركاته حسب علمي في Microsoft Excel لا يمكن الانتقال لخلية أخرى “تلقائيًا بالكامل” أثناء الكتابة بدون أي إجراء من المستخدم، لأن الخلية تبقى في وضع التحرير حتى يتم تأكيد الإدخال. لكن يمكن بطريقة اخرى عن طريق فورم بحيث يتم فتح الفورم ثم اختيار اول خلية المراد ادخال الدرجة اليها ويكون الامر تلقائيا والتكست بوكس يتعامل مع اي عمود بشرط تحديد بداية اول للدرجات والكود يتعامل مع درجتين مثل 15 او 45 فبمجرد الانتهاء من كتابة الرقم الثاني يتنقل المؤشر تلقائيا الى الخلية التي اسفل منها اذا وجدت درجات من رقم واحد مثل 7 يجب كتابتها في التكست بوكس 07 اذا كانت لديك درجات من 3 ارقام مثل 123 يتم التعديل بالكود في الجزء If Len(v) >= 2 Then يتم تعديل 2 الى 3 ادخال الدرجات.xlsb

تفضل لعل هذا طلبك مع ان الملف القديم كان يحدد النتائج بمجرد الضغط على زر بحث. تم استبدال أول أسماء الأصناف بكلمات حقيقية لتجربة البحث بالأسم لأن الكل كان يبدأ بحرف ص 3 _ شهر ابريل1 2026.xlsm

الإصدار الأول ( لا أعتقد أنه النهائي 😁 ) من اللعبة المطورة لعبة النباتات ضد الثعبان 2026 .. كما رأيتم في الفيديو والصور التي تم طرحها في بدايات تأسيس اللعبة ، هي تجسيد للعبة الثعبان الشهيرة ولكن بنكهة فوكشية خنفشارية .. كيفية اللعب :- 1️⃣ التحكم سيكون بمفاتيح الأسهم في لوحة مفاتيحك ، لتتحكم بحركة الثعبان في الإتجاهات الأربعة . 2️⃣ عليك ان تجمع أكبر نتيجة من اكل التفاح الأحمر . 3️⃣ هناك في ساحة اللعبة تم إضافة مساعدات وأدوات إعاقة ممتعة تتلخص بما يلي :- التفاحة الحمراء = وتعطي اللاعب 10 نقاط ، وتزيد من طول الثعبان . التفاحة الخضراء = وتعطي اللاعب 50 نقطة ، أيضاً تزيد من طول الثعبان . كيس النقود = ويعطي اللاعب 100 نقطة مكافأة 💰 . شعلة النار = تعطي اللاعب 80 نقطة ، ووظيفتها تجميد حركة الوحش في اللعبة 😈 . إكسير التجميد = يعطي اللاعب 50 نقطة ، ووظيفته تجميد حركة النبتة التي تقذف القنابل 🥶 . القنبلة الأرضية = تعطي اللاعب 30 نقطة ، ووظيفتها تفجير صخور الإعاقة التي تعيق حركة الثعبان 💥 . القلب = لا يعطي أي نقاط ، ولكنه يقوم بزيادة عدد أرواح الثعبان في اللعبة ( بحد أقصى 3 أرواح ) ❤ . البوابات السحرية = أيضاً لا تعطي نقاط ، ولكنها تقوم بنقل الثعبان من مكان إلى مكان آخر ( حسب ظهور البوابات ) 🕳 . التاج الملكي 👑 = لا يعطي أي نقاط ، ولكن عند ظهوره في المستوى الـ 20 ( آخر مستوى في اللعبة ) ، فإنه يقوم بإنهاء اللعبة وإعلان الفوز . طبعاً سيظهر في مكان عشوائي ، وعلى الثعبان أكله حتى تنتهي اللعبة . أما المعوقات ، فاكتشفوها بانفسكم 😉 :- 🔴 جميع الصور داخل النموذج هدفها عدم استخدام أي مسار خارجي للصور عند التبديل أثناء الحركة وذلك بهدف تقليل الوميض والترميش . وطبعاً الترميش والوميض مرهون بمواصفات الجهاز . وبالتأكيد الأجهزة القديمة أو البطيئة قد تلاحظ الترميش بشكل أكثر قليلاً من الأجهزة المتوسطة والسريعة . 🔴 مفتاح Esc وظيفته أيقاف اللعبة مؤقتاً ، ونفسه للإستمرار 😎 . 🔴 سهواً سقطت مني الجملة :- KillTimer 0, hTimer في حدث عند الإغلاق للنموذج Frm_Game ، ليصبح الحدث :- Private Sub Form_Close() On Error Resume Next Form_SetComposited Me, False KillTimer 0, hTimer DoCmd.Quit End Sub وفي الختام أترككم مع تجربة اللعبة مفتوحة المصدر .. فقط استخدم مفتاح الشيفت إن أردت قراءة الأكواد أولاً قبل اللعب 😁 . Plants VS Snake.zip

جرب الملف و تأكد أن تعمل توسيط للأرقام في الخلية الدوائر تعمل تلقائيا بمجرد ادخال الرقم و تختفي تلقائيا لو تم التعديل بداية من 50 دائرة حول الرقم.xlsm

تفضل <<<<<<<<<<<<<<< التعديل يكون في الجدول وليس النموذج مثال عملي.accdb

أعاده الله علينا وعليكم وجميع المسلمين بالخير واليمن والبركات وماحاجتك إلى تكبير الصورة الخارجية ؟؟؟ هذه هي الأبعاد التقريبية للبطاقة 8×5 سم كذلك فأن قراءة الباركود من بطاقة مطبوعة يختلف عن القراءة من الشاشة حيث أنك تقوم بتقريبها إلى جوار قارئ الباركود ولكن إذا قمنا بتكبير الصورة الخاصة بالكود ستغطي على البيانات فمثلا قمت بتعديل أبعاد الصورة الخاصة بالـ QRCode لتصبح 2×2 سم وهذه كانت النتيجة عموما بإمكانك أنت تعديل أبعاد الصورة حسب رغبتك تحياتي

مقترح الاستاذ منتصر الانسي @منتصر الانسي ممتاز جدا و ممكن يكون فعلا بداية جيده لتطبيق هذه الاجتماعات و كذلك مقترح الاستاذ موسي @Moosak لذلك سأقوم باختيار احد الموضوعات التي سمكن لي ان اقوم بعمل مادة علمية . و لكن محتاجين ان تكون هذه المشاركات التي ستؤدي الي الاجتماعات الشهري لها طابع خاص غير المشاركات العادية لذلك أقترح على حضراتكم ان تكون مثل مشاركات التحديات - لا اعرف الكيفية و لكن البركة في حضراتكم-

إسمحوا لي بأن أدلو بدلوي في هذا الموضوع بحيث لن أكون متفائل كالأخ @mohammed farhat او متشائم كالأخ @Foksh وأنما أقدر أقول أكثر واقعية الآن إذا ما رجعنا للغاية التي تم من أجلها إنشاء منتديات أوفيسنا وموفع مجموعة مستخدمي أكسس نجد أن أوفيسنا حاله كحال جميع المنتديات العالمية مثل منتدى Microsoft Access Help Center لن تجده يركز على العروض التقديمية لأنه في الأساس قد أنشئ ليجد فيه المستخدم المبتدئ ضالته عندما يريد التعلم أو إيجاد حل لمشكلة تواجهه لذا فستجد أن أغلب أعضاؤه إما أشخاص يطلبون معلومات أو حلول (المبتدئين) أو أشخاص (وهم الأكثر خبرة) يحاولون قدر ما أمكنهم الإجابة على هذه التساؤلات وأغلب أعضاء المنتدى هم من الهواة أي أنهم غير دارسين للبرمجة بل تجد أغلبهم إما معلمين أو محاسبين أو إداريين أي أن تخصصاتهم العلمية هي تخصصات مالية أو إدارية وليست برمجة والأهم من كل هذا أن القائمين على المنتدى هم أشخاص يقومون بعمل تطوعي لايرجون منه إلا الثواب والاجر من الله. على الجانب الآخر فنجد أن موقع مجموعة مستخدمي أكسس هو موقع عالمي (مهمته الأساسية هي العروض التقديمية عبر النت) وهذا يعني (أن القائمين عليه يعملون بدوام جزئي أو كامل) وعالبية أعضائه (خصوصاً من يقدمون هذه العروض) هم من المطورين الذين يقومون بتطوير منتجات مايكروسوفت أو من الحاصلين على لقب MVP من مايكروسوفت لذلك ستجد أن المواضيع التي يقدمونها هي مواضيع إما أنها تختص بالتحديثات المستقبلية التي تقوم بها مايكروسوفت أو مواضيع متقدمة تهم الأشخاص الأكثر خبرة وإحترافية فلو رجعنا الى الموقع او حتى للقائمة التي ذكرها الاخ محمد ستجد أن المواضيع تناقش خارطة طريق تحديثات اكسس أو إستخدام الذكاء الصناعي مع اكسس أو ربط أكسس مع SQL Server... إلخ لذلك عندما نجد أن هناك مبادرات مثل هذه المبادرة أو مثل مبادرة الأخ @Moosak فيجب علينا تشجيعها ودعمها ولكن في نفس الوقت لانتوقع أن يتم التفاعل من جميع الأعضاء فهناك من سيكون غير متفرغاً في وقت العرض ومنهم من لن يكون مهتم بموضوع العرض وعدد لابأس منهم لن يستوعبوا الموضوع لأن مستواه أعلى من إمكانياتهم .... وغيرها من الأسباب ولكن في الأخير (وهذه أهم نقطة يجب التركيز عليها) سنكون قد ربحنا مادة علمية ستكون مرجعاً هاماً وباللغة العربية لكل باحث يريد أن يتعلم أكسس . خلاصة القول والذي أريد إيصاله أنه يمكننا البدء بإنشاء آلية عمل تشبه التحديات الشهرية ولكن بطريقة عكسية فبدل أن يتم ترشيح المواضيع سيقوم كل من يجد نفسه قادراً على إعداد مادة علمية لموضوع معين (أو أكثر) بإنشاء منشور للإعلان عن هذا الموضوع والتاريخ والوقت الذي سيتم فيه العرض وعلى كل من يجد في نفسه الرغبة المشاركة في الحضور أن يبدي رغبته عن طريق الرد على هذا المنشور وإذا رأى صاحب المنشور أنه قد حصل على العدد الكافي يقوم بتأكيد الموعد وطريقة المشاركة مالم فيتم إغلاقه وبهذا يوفر على نفسه التعب والإحباط .

بدايةً وعليكم السلام ورحمة الله وبركاته.. وأتمنى أن لا تكون كلماتي في ردي هذا محبطة لك ولجهودك ، وأن لا تكون كالملح فوق الجرح مؤلمة .. وكما اختصر الكلام في قسمنا هذا ، مشاركة وتفاعل الكثيرين من منتسبي قسم الآكسيس . فإن قسمنا - مع احترامي للجميع - يفتقر الى روح المشاركة والمعنوية التي تجعلنا نُقدم على هذه الخطوة . فأغلب التفاعلات هنا مجرد :- يدخل البعض ليبحث عن موضوع لم يشارك به أحد ، وكأنه ماراثون "كلمة مقتبسة" . يدخل البعض أيضاً لا يكلف نفسه حتى عناء البحث باستخدام ميزة البحث في المنتدى. فتراه يرمي موضوعه دون شرح او توضيح كافي ، أو أحياناً دون مرفق . وهذا النوع لا لوم عليه من التفاعل في أي مواضيع لأنه يبحث عن معلومة . ترجمة رقم عدد الزيارات للمواضيع المطروحة ، تدل على أن الأغلبية لدينا في قسمنا ، جمهور صامت !! حاله كحال جمهور في مباراة كرة قدم دون أي تفاعل ولا حتى كمشجع ، وقد يكون أحياناً غير منتقد أيضاً 😅 . ينقصنا في قسم الآكسيس شيء واحد فقط وهو ، الترابط الاجتماعي . فأحياناً كثيرة نجد أن معظم الردود تؤخذ على محمل شخصي ، ولا تؤخذ على محمل أن اختلاف وجهات النظر لا يُفسد للودّ قضية . لذا أتمنى أن نلمس في القسم صحوة للكثيرين بتفاعلهم ومشاركاتهم بأفكارهم ، ليس فقط في الردود وكأننا آلات مبرمجة على مبدأ سين سؤال وجيم جواب . وحتى لا ينزعج أحد من ردي هذا ، فقد أكون أولكم ممن تلمسه جميع الملاحظات ، ولا أزكي نفسي عليكم بل أول المقصّرين . شكراً لمن قرأ للنهاية ، ووصل الى هذا الحد بصدر رحب ، وعلى من لا يأخذ كلامي وكأنه المقصود 💐 .

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

السلام عليكم ورحمة الله وبركاته أود أن أحيطك علماً بأن جميع ما قمت به من حلول في المشاركات السابقة، كانت اجتهاداً شخصياً مني ، وذلك بسبب عدم شرح تفاصيل الطلب بدقة، وغياب الشكل المتوقع للمخرجات في بداية طلبك في اول مشاركة. وهنا أود أن أسترعي انتباهك ولجميع احبابنا اعضاء المنتدى الكريم لنقطة تنظيمية وإدارية هامة : عند طرح أي سؤال أو طلب فكرة برمجية مستقبلاً، من الأفضل دائماً تجهيز ورقة عمل (شيت) داخل الملف كنموذج تصوري للنتائج، أو شرح آلية ومكان ظهور المخرجات بدقة (مثل: شكل الجدول المطلوب، وتحديد الأعمدة، وهل تريدها في نفس الورقة أم في أوراق منفصلة؟). وهذا يضمن اختصار الوقت والجهد وتفادي كثرة التعديلات المتكررة. وتكون النتائج تماماً كما تريدها وبتنسيقها الصحيح وتفاعل اعضاء وخبراء المنتدى اكثر. على أية حال، حسب فهمي لطلبك في مشاركتك الأخيرة؛ فقد تم دمج الفعاليات النشطة واللجان الخاملة معاً في شيت واحد متكامل، كما تم تعديل عدد اسماء المشاركين الى 15 عمود في طلب سابق لكم. تقبل وافر شكري، وعميق تقديري لشخصكم . لا تتردد في طلب التعديل ان كان الحل لا يلبى طلبك مؤشر عمل اللجان1 (1).xlsb

السلام عليكم ورحمة الله وبركاته اظافة الى حل استاذتا اأبومروان حيث يثمثل الحل بطريقتين اذا اردت معرفة عدد الندوات التي شارك بها اي مشارك واحد انقر على اي اسم مرتين تظهر رسالة بعدد المشاركات والغعاليات اما اذا اردت كل المشاركين يوجد زر يقوم بانشاء ورقتين احداها لكل المشاركين والاخرى للفعاليات توجد بعص الفعاليات بها اكثر من لجنة (تعاون) ولإعطاء كل لجنة حقها؛ ففي حال تنظيم فعالية مشتركة بين أكثر من لجنة (مثل: لجنة الكتاب والنشر - ثقافة الطفل - الشباب "تعاون"), يجب أن يتم احتساب هذه الفعالية لصالح كل لجنة من اللجان المذكورة بشكل مستقل ومستساغ، بدلاً من قراءتها كنص واحد لكما كل التقدير والاحترام مؤشر عمل اللجان.xlsb

فيديو تجسيد لفكرة اللعب على الشبكة المحلية :- طبعاً الفكرة قيد التطوير لإيجاد بدائل لموضوع الربط والجداول في القاعدة الخلفية للجداول ..

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

وعليكم السلام ورحمة الله وبركاته هذه الدالة تقوم بالمهمة ان شاء الله صعها في f3 ثم اسحب لاسفل تحياتي =IF(B3="فروج مسحب"; D3*E3*2.55; D3*E3*1.85)

اختصارا للوقت ...... جرب المرفق التالي ..... يتم تكوين جدول بالمواد مهما كان عددها في الجدول <><><><><><><><><><><><> KAN_2.accdb

نعم الفاصلة العشرية موجود بالفعل في الفورم في الأعلى زر بلون أخضر مكتوب عليه 0.5 نصف درجة يضيف فقط 0.5 لأنها درجات لا يتعامل المعلمون مع غير هذا الكسر

السلام عليكم ورحمه الله وبركاته جزاك الله خيرا اخي أبومروان ويبدو ان الاداة ليست اضلية بمعنى ان مايكروسوفت لم تصدر أي تحديث يضيف XLOOKUP للإصدارات القديمة وتنزيل ملفات من مواقع غير رسمية قد يحمل مخاطر (فيروسات، أكواد ضارة). حاولت تحميل الملف اكثر من 6 مرات يقوم برنامج الحماية بحذفه بسبب وجود فيروس حسب نتيجة برنامج الحماية ولهذا لم اتمكن من الاطلاع على الملف للاستفاذة منه تحياتي

أولا .. أسعد اللحظات هو مرور السادة الكرام أمثالكم وثنائهم العاطر 😊🌹 والأسعد هو بسطكم لهذه العبارة والتي ينطق بها خبير وهو يعلم أن البضاعة مزجاة .. 😅🖐 بارك الله فيك أستاذنا العزيز .. مروركم تشريف ومنطوقكم وسام شرف 🙂🏆 لولا فضل الله ثم هذا التحدي لوجدتني أدور في نفس الدوامة المغلقة 😅 الشكر لحبيبنا @Foksh هو كان السبب 😂👊🌹

عملت استعلام داخلي ( فرعي ) متمثل في هذه الشيفرة المرتبطة بالجدول الاساسي SELECT Max(D2.Reg_Date) FROM Daily AS D2 WHERE D2.كود = Daily.كود بحيث يمر على كل سجلات حسب رقم الكود لاستخراج التاريخ الاكبر

كما هو ظاهر نقص في المكتبات لديك تفضل اعداد آخر ولكن اعتقد ستواجه المشكلة نفسها وايضا الفكرة على ملف اكسس Project1.rar حساب تاريخ الحمل.rar

تفضل استاذ @abkyasserabk محاولتي ، اليك الشرح والمرفق . حسب مافهمت . واذا ارسلت طلبك كما قال لك استاذنا @ابوخليل كان اسرع لي . تفضل ووافني بالرد . abkyasserab.rar

انا لم الاحظ أن هناك فرق قد يكون حجم البيانات عندك كبير مما يؤدي إلى ملاحظة هذا التأخير هناك خاصية مهمة يفضل إضافتها إلى الحقول التي يتم البحث عن بيانتها بكثرة وهي خاصية الفهرسة (في أكسس إسمها مفهرس أو Indexed) بالطريقة الموضحة بالصورة التالية الخيار المحدد هنا هو نعم مع السماح بتكرار نفس الإسم أكثر من مرة وإذا كنت متأكداً من عدم تكرار الإسم يمكن إختيار نعم بدون تكرار وهذا سيكون طبقة حماية إضافية حتى لايتم تكرار الأسماء الآن بعد أن تقوم بتعيين هذه الخاصية جرب عملية البحث هل ستكون أسرع؟ في حالتك هذه يفضل أن يكون النموذج الذي تبحث فيه إما نموذج فرعي أو نموذج مستقل عن نموذج البحث (النموذج الذي يتم إدخال نص البحث فيه) وهذا بسبب أنه يتم تنفيذ تحديث أو Requery للنموذج أثناء إدخال نص البحث ولكن لو كان البحث يتم بعد إدخال النص كاملاً فلن تكون هناك مشكلة عموما جرب تطبيق خاصية الفهرسة على المثال السابق وشوف النتيجة هل سيتحسن الأداء أم لا ومن ثم نشوف حل للطريقة الثانية التي قلت عليها (أن يكون نفس النموذج) تحياتي

طيب ايش هي المشاكل ,, انت الآن طلبك كالآتي :- 1. حساب عدد الخلايا الغير فارغة لكل لون في الأعمدة . صحيح ؟؟ الآن المشاكل التي تقصدها :- 1. عند تغيير لون الخلية لا يتم تحديث القيم في أعداد الخلايا التي كتبنا فيها المعادلات ، صحيح ؟ يعني انت تريد عند التغيير للون أي خلية ، أن يتم التعديل مباشرة في أعداد الألوان في الأعمدة ؟؟؟؟؟؟؟؟؟؟؟؟؟ وهنا المشكلة أخي الكريم .. فتغيير اللون ليست حدث أو قيمة يشعر بها آكسل للأسف وبالتالي لن يتم تحديث التعداد إلا إذا !!!!!! في حدث عند التحديث للورقة ، كالتالي :- Private Sub Worksheet_SelectionChange(ByVal Target As Range) Application.Calculate End Sub قمنا بإعادة حساب كل الصيغ والمعادلات في الورقة مرة أخرى ، بمجرد أن تقوم بالتحرير داخل اي خلية ، ثم الخروج . خلاف ذلك لا اعتقد ان ذلك ممكن .

تطوير جديد تم رفع المرفق في الموضوع الأساسي

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

أعمال مميزة ، ومشاركات جميلة ومفيدة من الأساتذة @Ahmedgamall و @Barna ..

ليس بالضرورة أي شيئ مما سبق فالمواضيع الخاصة بالمكتبة عادة تكون على سبيل الهدية من قبل العضو لبقية أعضاء المنتدى للإستفادة منها بعكس المواضيع التي يتم نشرها في المنتدى والتي تكون إما مشاكل أو إستفسارات مطلوب الرد عليها بل بالعكس قد يكون عدم التفاعل هو نتيجة لسهولة العمل بالملف وعدم الإحتياج لأي إستفسار حوله فمن خلال تجربتي مع {سلسلة الادوات المساعدة المخصصة} الخاصة بي ورغم ندرة التفاعل فيها إلا أني أجد أن الكثير قد قامو بتحميلها والاستفادة منها في تطبيقاتهم وتكون سعادتي أكبر عندما تصلني كلمات والشكر والاعجاب لاحقاً وفي مواضيع أخرى وهذا هو المردود الحقيقي الذي يبتغيه صاحب العمل أن يشعر بأن عمله له التأثير الإيجابي لدى الآخرين .

تطوير 5 اقتباس من واجهات الاستاذ موسى مع بعض تصرف عمل نظام صلاحيات خفيف ومختصر توسع من اجل التطوير مستقبلا الادمن كلمة المرور =78 البقية كلمة المرور =1 اتمنى تجدوا الفائدة والمتعة KhlAcc5.rar

السلام عليكم جرب التعديل التالي طلب تعديل كود.xlsm