اذهب الي المحتوي
أوفيسنا

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

  1. Foksh

    Foksh

    الخبراء


    • نقاط

      161

    • Posts

      1,468


  2. ابوخليل

    ابوخليل

    أوفيسنا


    • نقاط

      102

    • Posts

      11,710


  3. kkhalifa1960

    kkhalifa1960

    الخبراء


    • نقاط

      99

    • Posts

      1,480


  4. محمد هشام.

    محمد هشام.

    الخبراء


    • نقاط

      54

    • Posts

      1,045


Popular Content

Showing content with the highest reputation since 16 مار, 2024 in all areas

  1. السلام عليكم ورحمة الله وبركاته أسعد الله أوقاتكم بكل خير وسرور .. وتقبل الله منا ومنكم صالحات الأعمال .. 😊🤲🏻 يطيب لي أن أقدم لكم هذا الهدية المتواضعة بمناسبة هذا الشهر الفضيل 🙂🌼🎁 استبدل الرسائل العادية في أكسس برسائل ذات تصاميم قمة في الإبداع وبمميزات إضافية . من مميزات هذه الرسائل: - تصميم جميل وألوان جذابة. - خاصية ذاتية الاختفاء. - عنوان رئيسي + عنوان فرعي - تحكم بالنص ( عربي - إنجليزي ) ( توسيط - محاذاة على اليمين أو اليسار) - سهلة الاستخدام . الشرح على اليوتيوب : التحميل 🙂 Moosak MsgBox.accdb ولا تنسوني من صالح دعواتكم 😊🌷🌼🌹
    7 points
  2. وعليكم السلام 🙂 مشاركة مع اخوي @Foksh 🙂 هذا كود تفريغ حقل البحث، اذا كان النقر على زر البحث: Me.Txt_Search = "" او Me.Txt_Search = Null او Me.Txt_Search = Empty ثم Me.Txt_Search.Setfocus . اما اذا لم يوجد زر بحث، وكان الكود يعمل البحث على حدث "بعد التحديث" لحقل البحث ، فيجب ان ننقل التركيز على اي كائن في الموذج يقبل التركيز، ثم نستعمل الكود اعلاه ، هكذا مثلا: دائما في نماذجي عندي زر لغلق النموذج اسمه cmd_close فعليه يصبح الكود: me.cmd_close.setfocus Me.Txt_Search = "" او Me.Txt_Search = Null او Me.Txt_Search = Empty ثم Me.Txt_Search.Setfocus . جعفر
    7 points
  3. السلام عليكم ورحمة الله وبركاته ، أخواني وأساتذتي ومعلمينا ( دون استثناء ) لكثرة الطلبات على برنامج إدارة الحضور والإنصراف للموظفين ، وددت مشاركتكم النسخة الأولى الغير مفتوحة المصدر حالياً ، لحين الإنتهاء من التعديلات التي ستتم على البرنامج . دون الإطالة في المقدمة ؛ سأشرح لكم بعض ميزات البرنامج :- أولاً سيتم إضافة الإعدادات الضرورية للبرنامج وهي :- تصنيف الموظفين ( ولكل تصنيف سيتم تحديد عدد أيام الإجازات السنوية له ) . تصنيف الإجازات ( طارئة ، مرضية ، ..... إلخ ) . تحديد وقت بداية ونهاية ساعات العمل الرسمي ، و تحديد مدة السماح للتأخير ( المرونة في العمل ) ، تحديد عدد مرات التأخير ليتم احتساب يوم إجازة في اليوم الأخير من المدة . ثانياً ومن الطبيعي وجود موظفين في قاعدة البيانات ، سيكون قسم لإدخال بيانات الموظفين بشكل بسيط من المعلومات ( ولكم حرية التوسع حسب رغبتكم وحاجتكم كمستخدمين ) ، وطبعاً لكل موظف رقم وظيفي خاص به اعتمد على سلسلة مكونة من التاريخ والوقت الحالي بدون مسافات بهذا التنسيق YYYYMMDDhhmmss ، بحيث لا يكون هناك تكرار نهائي لأي رقم موظف . ثالثاً لوحة تسجيل الحضور والإنصراف عن طريق الرقم الوظيفي ، وتدعم القراءة من الباركود الموجود على باجة الموظف ( طبعاً لاحقاً سيتم إضافة طباعة باجة أو بطاقة للموظف ) ، وفي هذه اللوحة لن تحتاج تحديد الحالة ( حضور أو إنصراف ) فقط أدخل رقم الموظف وسيتم احتساب وقت الحضور وتسجيل مدة التأخير بالدقيقة في الجدول ، وكذلك الأمر للإنصراف . رابعاً لوحة تسجيل الإجازات ، وطبعاً بناءً على المعطيات التي تم إدخالها في نماذج البيانات الأساسية في الإعدادات - سيكون الأمر بسيطاً جداً وتم اعتماد رقم الموظف في المرحلة الأولى من البرنامج وسيتم اعتماد اسم الموظف أيضاً لجلب البيانات لاحقاً . بخطوات بسيطة بعد ادخال رقم الموظف نحدد تاريخ بداية الإجازة ، ثم عدد الأيام المطلوبة كإجازة ، ثم سيتم تلقائياً احتساب يوم نهاية الإجازة ، وطبعاً نوع الإجازة المطلوبة ستقوم باختياره من قائمة نوع الإجازة . خامساً لوحة التقارير ، بحيث سيكون لدينا في المشروع تقرير واحد فقط لكنه سيخدم جميع الطرق التي تريدها كمستخدم ( تقرير للموظفين جميعاً مع وبدون تحديد فترة ، تقرير لموظف واحد مع وبدون تحديد فترة ) . *وطبعاً ما زالت قيد التطوير بشكل خاص ملاحظة:- تم حفظ البرنامج بصيغة Accde كونه قيد التطوير والتعديل حالياً اقترب عيد المسلمين مودعين به شهرهم الفضيل أعاده الله علينا وعليكم باليمن والبركات . وتقبل الله منا ومنكم الطاعات وصالح الأعمال . وسأختم به آخر تعديل على هذا المشروع البسيط ؛ متمنياً أن يكون على قدر الجهد المبذول فيه . وأعتذر بداية عن التأخير في انهاء العمل عليه ، ولكن لضيق الوقت ليس إلا . اليوم انهيت تأسيس الأساسيات في برنامج إدارة الحضور والإنصراف الذي يعمل بنظام بصمة الـ QR . وسأذكر بالتفصيل البسيط ما تم إضافته . الإضافات في النماذج :- ربط قارىء QR يعمل عن طريق الـ USB أو عن طريق الجوال بالنظام . دعم كامل لللغة العربية في قراءة رمز الإستجابة السريعة QR . اعتماد اسم الموظف بالإضافة الى رمز الـ QR . نظام التنبيه لضبط الإعدادات الرئيسية في البرنامج عند تشغيله أول مرة . إحصاء لعدد الموظفين ، الحضور ( على رأس عملهم ) ، المجازين ، المغادرات خلال اليوم . ترحيل بيانات الإجازات والمغادرات والحضور بشكل شهري ( بداية كل شهر ) . الإضافات في الأكواد :- تمت مراجعة جميع الأكواد من أي خطأ محتمل في التنظيم أو آلية العمل . تم إضافة فكرة تثبيت برنامج الربط Barcode2Win من خلال الأكواد ، وفي حال عدم وجوده يتم تحميله من الموقع الرسمي ( يتطلب انترنت ) . تم دمج العديد من الإستعلامات في الأكواد لتقليل مكونات وعناصر النظام وتخفيف العبئ عليه . تم تقسيم العديد من الوظائف لسهولة التعامل معها وصيانتها . تم إضافة نموذج لإعادة تهيئة النظام وتفريغ محتوياته ( الجداول ) ، طبعاً باسوورد تأكيد العملية مدمج في أكواد النموذج . العديد من المميزات التي ستجدونها في المشروع
    5 points
  4. السلام عليكم 🙂 عملت على مشروع لمؤسسة خيرية فيه العديد من المستخدمين ، والعمل هو عبارة عن طباعة نحو 1000 كوبون خلال ساعة واحدة لوجبة غذاء مجانية ، وحوالي 600 كوبون خلال ساعة اخرى ، والكوبون يحتوي على شعار المؤسسة، وشعار آخر يتغير شبه كل يوم. الطرق المتبعة لعرض الصور في التقرير هي: قراءة الصور من مجلد المشاركة، ولكن قراءتها لكل كوبون، يجعل الشبكة مزدحمة بمرور الصور فيه، مما يعمل بطئ في الشبكة، نسخ الصور من مجلد المشاركة الى مجلد محلي على كمبيوتر المستخدم عند تشغيل البرنامج، ومن ثم قراءة الصور من المجلد المحلي عند طباعة كل كوبون، اما الطريقة الاسرع من الطريقتين اعلاه هي: عرض الصور من مجلد المشاركة عند تشغيل البرنامج، في النموذج الرئيسي للبرنامج في حقل الصور، عرض الصور في التقرير، بقراءة كل صورة من النموذج الرئيسي، هكذا لصورة واحدة: في التقرير، على حدث "عند التنسيق" في قسم Details التفصيل نضع هذا الكود Forms!frm_Main!myPic هو اسم حقل الصورة في النموذج الرئيسي pic هو اسم حقل الصورة في التقرير Private Sub Detail_Format(Cancel As Integer, FormatCount As Integer) Me.pic.PictureData = Forms!frm_Main!Mypic.PictureData End Sub جعفر
    5 points
  5. السلام عليكم رمضان كريم لمن يريد الغاء تمكين مفتاح الشفت واعادة تمكينه مرة اخرى ارفق هذا المثال لأجل الفائدة فورم الواجهة الرئيسية هو start عملت ازرار اثنين احدها قفل الشفت بمعنى عدم تمكينه مرة اخرى بعد غلق البرنامج واخر لتمكين الشفت بعد غلق البرنامج وفتحه مرة اخرى ملاحظة / بمكنك من اجل التمويه وضع صورة صغيرة او ايقونة للأزرار حتى لايتبين ذلك ملاحظة اخرى الازرار تفتح وتغلق بكلمة مرور هي 1234 وبامكتنكم تغييرها من موديل اترككم مع البرنامج وهو على اوفس 2010 ارجو منه ان يستفاد من يحتاج لهذا البرنامج مفتاح الشفت.rar
    5 points
  6. استاذ @gavan من وجهة نظري كل البرامج تعتمد على تقسيم القاعدة . فأنت هنا بالاكسس يمكنك تقسيم القاعدة أماميه وبها (الاستعلامات والنماذج و التقارير و الموديلات و الوحدات النمطية)، والقاعدة الخلفية وبها الجداول وممكن تقسم القاعدة الخلفية كمان مجموعة جداول بقاعدة والمجموعة الباقية بقاعدة أخرى والربط بين القاعدة الأمامية والقواعد الخلفية بالطريقة السليمة . تحياتي .
    5 points
  7. فى ظل امكاناتي المتواضعه وللحاجه وبعد مراجعة العديد من الحلول المتوفره على الويب التى لم اجد بها ضالتي اقدم لكم مربع التلوين هذا colorpicker حيث يقوم بتلوين خلفية النموذج بشرط تسميتها detail بالانجليزيه ورأس النموذج بشرط تسميته header وتذييل النموذج بشرط تسميته footer وكذلك مربعات التنسيق والتجميل rectangle بشرط ان يتم تسميتها box1 , box2 وهكذا وضعت وظائف التلوين فى حدث عند النقر المزدوج فى كل منها طبعا يمكن استخدام اسماء عناصر عربيه لكنها ستحتاج تعديل فى الجدول والكود ولا افضل ذلك المربعات الونيه يمكن تلوين حتى box9 اى تسع مربعات النموذج يحتوي اكثر من 400 لون معد سلفا منها 160 لون عشوائي تتغير بضغطة زر الى اخرى كل لون تختاره يمكنك التعديل عليه بتغيير قيم الالوان الاحمر والاخضر والازرق يوجد جزء خاص لضبط الخطوة فى + او - بقيم من 1 حتى 25 كما يوجد جزء خاص بتحديد سلوك تلوين الفورم فى المره القادمه التى سيفتح فيها وامامك 3 خيارات اما استخدام خياراتك الاخيرة للالوان واما استخدام الوان الجدول الافتراضيه وهى الوان رماديه يمكن تغييرها من الجدول فقط واما استعادة الوان الفورم عندما تم تصميمه ويتم التحكم فى كل جزء على حده اعلم انه بدائي لكنه يؤدي الغرض بفاعليه ونرحب بالافكار الجديده الكود متاح للجميع استخدامه شخصيا او تجاريا بشرط عدم ازاله شعار مؤسسة وعد الخيريه او كود الصوره اتمنى تزويدي بتعليقاتكم البرمجيه لتحسي الكود وتطويره لتعيين الصور كخلفيات يمكن التحميل من هنا mycolorpiker.zip
    4 points
  8. السلام عليكم كنت ابحث عن برنامج على جهازي الكمبيوتر بالصدفة وجدت هذا الملف الرائع احببت المشاركة معكم للفائدة اكواد كسس مهمة.rar
    4 points
  9. 4 points
  10. اقدم لكم برنامج مطعم كلاسيكي مفتوح المصدر. به بعض الكودات من أعمال بعض المنتسبين بمنتدانا (أفسينا)..... (به 33 طاولة طعام + دليفري + تيك أواي) ....والمهتم سيكتشف مابه ....... وأي استفسار أنا حاضر . اليكم لينك المرفق . https://www.mediafire.com/file/j0qasl6mlv1ju3x/CoffeShop.rar/file
    4 points
  11. عانيت كثيرا فى ايجاد حلول لتوسيط النموذج بوسط الشاشه حتى الذكاء الصناعي اربكني وبعد تجربه العديد من الاكواد والامثله انتبهت اخيرا لان اكسس يقيس الابعاد بالتويبس وويندوز يعتمد البكسل والبكسل حوالي 15 تويبس وهنا تم حل المشكله اليكم مثال بسيط جدا وبموديول واحد لاغير اتمنى ان ينفع احد اخواني ولا يفوتني شكر الجميع فمنكم نتعلم المثال مرفق waadcenterform.accdb
    4 points
  12. مشاركة مع اخي خليفة اسهل طريقة لترقيم حقل نصي هي الاستفادة من حقل الترقيم التلقائي الخاص بالجدول ... ويصبح الكود هكذا id = "RV." & Me.autoNmber على اعتبار Me.autoNmber هو حقل الترقيم التلقائي وهنا لست بحاجة الى اضافة اصفار .. لأن الترقيم التلقائي سيمتد الى مئات الآلاف
    4 points
  13. السلام عليكم ورحمة الله وبركاته اخواني الكرام.. قرأت أكثر المواضيع التي تتعلق بموضوع الباركود والـ QR . إلا انني أبحث عن شيء محدد ، ولا أخفيكم أنني حاولت ابتكار فكرة تعمل بشكل عكسي تقوم على مبدأ أنه عند قراءة الباركود داخل آكسيس يقوم بإدراج البيانات من الباركود الى مربعات نص محددة. على سبيل المثال ( تمت التجربة على QR ):- ( رقم المريض ، اسم المريض ، رقم الهاتف ، العمر ) هذه المعلومات تمت إضافتها في QR وانشاء صورة . المطلوب أنه عند قراءة هذا الـ OR في النموذج ان يتم ادراج القيم في مربعات النص التي يتم تحديدها ( علماً بأن النموذج هذا ليس له مصدر بيانات جدول او استعلام وغير مطلوب حفظ القيم داخل اي جدول . وهذه صورة QRتحتوي العديد من البيانات للتجربة لم أقم بارفاق ملف لأنني رغبت بان يكون الموضوع مفتوح بأكثر من اتجاه وليس ضمن فكرة محددة . المطلوب :- طريقة تجعلني عند قراءة الباركود ان يتم ادراج البيانات التي يحملها في مربعات نص محددة !!
    4 points
  14. Dim db As DAO.Database Dim rs As DAO.Recordset Dim fld As DAO.Field Dim searchNumber As Long Dim found As Boolean searchNumber = Me.C Set db = CurrentDb() Set rs = db.OpenRecordset("SELECT Salary.GradeNO, Salary.[1], Salary.[2], Salary.[3], Salary.[4], Salary.[5] FROM Salary ORDER BY Salary.GradeNO DESC;", dbOpenDynaset) i = 0 found = False Do Until rs.EOF For Each fld In rs.Fields If Not IsNull(fld.Value) And fld.Value = searchNumber Then found = True ElseIf found And Not IsNull(fld.Value) And i < Me.D And fld.Name <> "GradeNO" Then i = i + 1 Me.G = fld.Value Me.E = rs!GradeNO Me.F = fld.Name End If Next fld rs.MoveNext Loop rs.Close Set rs = Nothing Set db = Nothing
    4 points
  15. استكمالا لكيفية التحديث بطريقة أخرى بعد الشكر لمساعدتكم في طرح الأفكار سوف أقدم لكم هذه الطريقة وقبل البدأ اريد ان أنوه على بعض الردود حول الجداول في قاعدة البيانات هل أقوم بإعادة ربطها بعد التحدث والجواب هو (لا) وذلك عند تحديث البرنامج اقوم بإعادة ربطها من جهاز المطور وكل أجهزة المستخدمون والسيرفر وجهازي اللي أطور البرنامج عليه مرتبطة بشبكة محلية داخل الشركة وبعد التحديث وعند تركيب البرنامج على أي جهاز فإن الجداول تتصل بقاعدة البيانات مباشرة . سوف أشرح الفكرة باختصار المتطلبات 1- جدول جديد يضاف في البرنامج مرتبط بقاعدة البيانات مباشرة يحتوي على حقل رقم النسخة 2- تصميم نموذج افتتاحي مصدره الجدول السابق 3- تصميم برنامج مساعد نسميه (Update.accdb ) ونضعه في مجلد البرنامج 4- مجلد مشاركة موجود على السيرفر نضع فيه البرنامج المحدث شرح خطوات البرنامج عند التحديث 1- عند اكتمال التحديث يضاف رقم النسخة الجديدة في النموذج على سبيل المثال (002) في النموذج الافتتاحي و في الجدول رقم النسخة 2-عند التشغيل يقوم البرنامج بمقارنة النسخة المخزنة في الجدول مع جدول حقل النسخة ، سوف يجد الاختلاف وتظهر رسالة يوجد تحديث 3- يغلق البرنامج (الاصدار القديم) ويفتح البرنامج المساعد 4- عند فتح البرنامج المساعدة يقوم بحذف النسخة القديمة ويستدعي النسخة الجديدة من مجلد المشاركة على السيرفر ويلصقها في نفس مجلد البرنامج بدل النسخة القديمة التفاصيل من المعروف أن البرنامج سوف يكون على الهاردسك ( C ) عند جميع المستخدمون في المجلد (Shaoon) وأيضا البرنامج المساعد (Update.accdb) وملحقات البرنامج مثل أيقونة البرنامج او ملفات التعليمات وغيرها 👇 النموذج الافتتاحي في البرنامج عند المستخدم ذو الاصدار 001 👇 النموذج الافتتاحي في البرنامج الوسيط ( Update.accdb ) 👇 انتهى الشرح في المرفق الشرح العملي ملاحظة هامة : عند تنزيل الشرح العملي فك الضغط وضع الثلاثة المجلدات في البارتشن (C) مباشرة ومن ثم الدخول على المجلد (Shaoon) وتشغيل البرنامج (Shaoon.accdb) Program.rar
    4 points
  16. وعليكم السلام ورحمه الله وبركاته جرب هذا التعديل كود عمل فورمات للخلية عند التعديل.xlsm
    4 points
  17. تفضل <><><><><><><><> قاعدة بيانات مدرسية.accdb
    4 points
  18. بسم الله الرحمن الرحيم السلام عليكم ورحمة الله وبركاتة اهلا بكم اعضاء المنتدى الكرام اعتذر جدا للغياب الطويل عن المنتدى ولكن اشتقت اليكم فقولت ارجع بكود ممكن يفيد البعض فى عملة يعتبر البحث عن البيانات من الامور التى يبحث عنها كل مستخدمى الاكسل حيث انها تسهل عليهم اعمالهم وتحليل البيانات لديهم ولكن اذا كان لديك بيانات كثيرة جدا فى شيت الاكسل فالامر هنا يكون شاق ومرهق ومن هنا قررنا انشاء كود بحث من خلال اليوزرفورم يقوم بالبحث عن البيانات وتلوين واظهار نتائج البحث يتم وضع الكود فى حدث التكست بوكس Dim Itemsaerch As String Dim rng As Range Dim cell As Range Dim lr As Long Sheet1.Cells.Interior.Pattern = xlNone Itemsaerch = Me.TextBox1.Value lr = Sheet1.Cells(Rows.Count, 1).End(xlUp).Row Set rng = Sheet1.Range("a2:a" & lr) For Each cell In rng If InStr(1, cell.Value, Itemsaerch) > 0 Then cell.Interior.Color = vbGreen End If Next cell If Me.TextBox1.Value = "" Then Sheet1.Cells.Interior.Pattern = xlNone ملف العمل فورم بحث جديد وتلوين نتائج البحث.xlsm
    3 points
  19. أولا : لمعرفة العناصر المرتبطة بأي جدول أو استعلام ( النماذج والتقارير التي تم استخدام هذا الجدول فيها ) .. اتبع الخطوات التالية : بعدها ستظهر لك جميع النماذج أو التقارير التي تستخدم هذا الجدول أو الاستعلام .. كرر هذه الخطوات لمعرفة العناصر المرتبطة بالجداول الأخرى .. 🙂 ثانيا : لتحليل أداء قاعدة البيانات لديك .. اتبع الخطوات التالية (ختر جميع العناصر الجداول والاستعلامات والنماذج والتقارير وووو....) : بعدها ستحصل على تقرير ونصائح للكائنات المذكورة في القائمة لتحسين الأداء 🙂
    3 points
  20. اقدم لكم برنامج تحفيظ اسماء الله الحسنى للكبار والصغار مفتوح المصدر. . اليكم لينك المرفق . https://www.mediafire.com/file/1hrvf0h938769yq/GodNames.v1.1.rar/file
    3 points
  21. وعليكم السلام اخوب محمد واهلا وسهلا بك في المنتدى ، وللاستفادة القصوى من المنتدى ، برجى قراءة قوانين المنتدى : اضغط هنـــــــــامن فضلك لقراءة القواعد كاملة و بصفة خاصة نؤكدعلى ما يلي 1- يمنع منعا باتا نشر أية مواد تخالف حقوق الملكية الفكرية و يرجى الابلاغ عن المشاركات المخالفة من خلال زر تقرير اسفل المشاركة 2-يجب استخدام خاصيةالبحث قبل طرح السؤال توفيرا للوقت و الجهد. 3-ضرورة كتابة عنوان واضح للموضوع يدل على محتواه ويعطي وصفاً مختصرا للسؤال. 4-ممنوع منعا باتاً كتابة عناوين سينمائية مثل عاجل ، نداء الي فلان ، الي الخبراء ، طلب مساعدة ، أريد حلا..... 5-يمكن استعجال الرد باستخدام تعبير -للرفع- و غير مسموح بالالحاح او اللوم فجميع الاعضاء يشاركون تطوعا طبقا لسعة وقتهم. ومخالفة ذلك تعرض الموضوع للحذف اما الرد على طلبك ، فهل هناك طريقة لتمييز السجل عن الآخر الذي به طريقة البيانات التي تريدها؟ بمعنى: هل هناك تسلسل معين في السجلات ، وانت دائما تريد السجل الاول والرابع ، وهل الفرز دائما يكون كما اوضحت في الصورة؟ وفي مثل طلبك ، ياريت ترفق بيانات من قاعدة بياناتك ، حتى تكون الصورة واضحة 100% وحينها لن يقصروا الشباب في الرد ان شاء الله 🙂 جعفر
    3 points
  22. ومشاركة مع الأخوة والأساتذة:- Private Sub StudentName_BeforeUpdate(Cancel As Integer) If DCount("*", "Student_Tbl", "StudentName = '" & Me.StudentName & "'") > 0 Then MsgBox "اسم الطالب موجود بالفعل في الجدول.", vbExclamation, "تكرار الاسم" Cancel = True End If End Sub
    3 points
  23. مشاركة مع استاذي @عبد اللطيف سلوم تفضل استاذ @طير البحر محاولتي حسب مافهمت .اليك الشرح والمرفق . 1- مسار الصفحة بالفورم Forms!frm_Tab!TabCtl0.Value = 4 ' frm_Tab = اسم الفورم ' TabCtl0 =اسم التاب كنترول حيث 4= رقم الصفحة' 5 2- كيفية فتح الفورم على تاب محدد وليكن page5 (سويت لك 3 نماذج ) للتوضيح . DDTabcontrolPages.rar
    3 points
  24. اقدم لكم برنامج حساب أيام العمل أو الاجازات بين تاريخين .......... (اختيار أيام العمل الاسبوعية + العطل الرسمية) مفتوح المصدر. . اليكم المرفق . DDDayWork.rar
    3 points
  25. تفضل أخي @salah.sarea ، هذا الكود لإضافة كلمة تحددها في النموذج الى جميع السجلات في الجدول الذي تختاره ، طبعاً باستثناء حقل الترقيم التلقائي :- Sub AddWordToAllFields() Dim db As DAO.Database Dim rs As DAO.Recordset Dim strSQL As String Dim strTable As String Dim strWordToAdd As String Dim fld As DAO.Field strTable = Txt_Tbl.Value strWordToAdd = Txt_Search.Value Set db = CurrentDb Set rs = db.OpenRecordset(strTable) For Each fld In rs.Fields If fld.Name <> "ID" And fld.Name <> "RecordID" Then strSQL = "UPDATE " & strTable & " SET " & fld.Name & " = IIf([" & fld.Name & "] Is Null, '" & " " & strWordToAdd & " " & "', [" & fld.Name & "] & '" & strWordToAdd & "')" db.Execute strSQL End If Next fld rs.Close Set rs = Nothing Set db = Nothing MsgBox "تمت إضافة الكلمة بنجاح إلى جميع الحقول في الجدول" End Sub Add_Word.accdb
    3 points
  26. في البداية كان سؤالك هكذا !! وهذا ما عملت عليه... referenceNo يتغير حسب اسم المشروع ويبدأ بالعد من جديد في بداية السنة الجديدة
    3 points
  27. جرب هدا Sub PrintArea() Dim F As Worksheet: Set F = Sheet1 Cpt = 18: A = 1: B = 4: C = 1 With F .PageSetup.PrintArea = "" .PageSetup.PrintArea = Range("A1", Cells(46, Cpt)).Address: .PrintOut Copies:=A .PageSetup.PrintArea = Range("A47", Cells(96, Cpt)).Address: .PrintOut Copies:=B .PageSetup.PrintArea = Range("A97", Cells(150, Cpt)).Address: .PrintOut Copies:=C End With End Sub او يمكنك تحديد الصفحات وعدد مرات الطباعة بالاعتماد على ورقة اخرى خاصة بالاعدادات كما في المثال التالي Public Property Get Sh_Print() As Worksheet: Set Sh_Print = Sheet1 End Property Public Property Get F() As Worksheet: Set F = Sheet2 End Property Sub To_print() déleteRow TbPage = F.[Tb_MiseEnPage] NbMax = UBound(TbPage) Cpt = Application.InputBox(Prompt:=" المرجوا ادخال رقم الصفحة المرغوب طباعتها (من 0 الى " & NbMax & ")", Title:="طباعة", Type:=1) Cpt = Int(Cpt) If Cpt < 1 Then Exit Sub If Cpt > NbMax Then: MsgBox " اخر صفحة على الملف هي : " _ & NbMax _ & "", vbExclamation, "المرجوا التحقق من رقم الصفحة المرغوب طباعتها": Exit Sub With Sh_Print .PageSetup.PrintArea = "" For i = 1 To Cpt With .PageSetup On Error Resume Next .PrintArea = TbPage(i, 2) & ":" & TbPage(i, 3): Copies = TbPage(i, 4) If Copies < 1 Then Copies = 1 .FitToPagesWide = 1 .FitToPagesTall = 1 On Error GoTo 0 End With Next End With Sh_Print.PrintOut Copies:=Copies End Sub '*********************************** Sub déleteRow() With F For i = F.[B65000].End(xlUp).Row To 2 Step -1 Application.ScreenUpdating = False If Application.CountA(Range(F.Cells(i, "B"), F.Cells(i, "C"))) = 0 Then F.Rows(i).Delete F.Range("A2:A" & Rows.Count).ClearContents Next i With F.Range("A2:A" & F.Cells(Rows.Count, "B").End(xlUp).Row) .Value = Evaluate("ROW(" & .Address & ")-1") End With End With Application.ScreenUpdating = True End Sub نمودج طباعة.xlsm
    3 points
  28. لان التقرير يفتح على الجدول مباشرة ولم تضع معيارا مناسبا لعرض ما يتم عرضه في النموذج تفضل التعديل ولكن طريقتك في التصميم ضعيفة يجب ان تدرس وتتعلم جيدا اضافة الصور3.rar
    3 points
  29. الزر النشط اي المستخدم حاليا والفكرة باختصار في عالم البرمجة نتجنب تكرار الامر كلما امكن ذلك
    3 points
  30. مشاركة مع الاستاذ ابو خليل الفكرة ان نستغني عن تكرار الامر بعدد الازرار وبدون الحاجة لكتابة اسم زر الامر عن طريق عمل اجراء نعلى النحو التالي Sub x() LabelNameText = ActiveControl.ControlTipText End Sub ثم في زر الامر نشير لاسم الاجراء فقط x الملف مرفق اخونا الشايب LabelName.accdb
    3 points
  31. Me.LabelNameText = Me.LabelNameA.ControlTipText LabelName.rar
    3 points
  32. ممكن تجرب Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer) ' F7 to clear search box If KeyCode = vbKeyF7 Then Me.SearchBox.Value = "" KeyCode = 0 ' Disable default behavior End If ' F8 to perform search If KeyCode = vbKeyF8 Then ' Add your search logic here MsgBox "Perform search" KeyCode = 0 ' Disable default behavior End If End Sub يجب وضع هذا الكود في النموذج الخاص بك، وتأكد من تغيير "SearchBox" إلى اسم مربع البحث الخاص بك.
    3 points
  33. وعليكم السلام ورحمه الله وبركاته بعد اذن اخى على عدل Dim Start_date As date, Last_date As date الى Dim Start_date As Double, Last_date As Double ووافنا بالنتيجه
    3 points
  34. اخي الكريم تكمن المشكلة ان البرنامج يفتح بوضعية Maximize وفي هذه الحالة تصبح التقارير خلف النموذج الرئيسي ، لذا افضل حل لديك الان هو عرض التقارير أيضاً بخاصية Maximize ، وإلا فلتستغني عن خاصية ملئ الشاشة للنماذج. من وجهة نظري 😊
    3 points
  35. السلام عليكم ورحمة الله أخي طارق لك وحشة... إن شاء الله تكون بخير وعافية... وهذه محاولة في الملف المرفق... 555.xlsx
    3 points
  36. السلام عليكم تفضل المرفق 555.xlsx
    3 points
  37. وعليكم السلام ورحمة الله وبركاته تفضل لعله لطلبك الراتب الاساسى212 مارس.xlsx
    3 points
  38. وعليكم السلام ورحمة الله نعالى وبركاته اظن انه يجب عليك اولا تغيير مكان خلية اختيار اسم المادة (N1) خارج نطاق البحث لانه في حالة تم اخفاء عمود مادة الدين مثلا عمود (N) سيتم اخفاء خلية الاختيار لنفترض ان الخلية المحددة هي (R1) Private Sub Worksheet_Change(ByVal Target As Range) If Not Intersect(Target, Target.Worksheet.Range("R1")) Is Nothing Then Dim x As Range, rng As Range Set x = Clé([R1], [G7:P7]): Set rng = Columns("E:F") Application.ScreenUpdating = False If x Is Nothing Then MsgBox "مادة" & " " & [R1] & " : " & " غير موجودة ", vbExclamation: Exit Sub Columns("C:P").EntireColumn.Hidden = True x.EntireColumn.Hidden = False: rng.EntireColumn.Hidden = False ActiveWindow.ScrollColumn = 1 End If End Sub Function Clé(a, b As Range) As Range Dim i& On Error Resume Next i = WorksheetFunction.Match(a, b, 0) If i Then Set Clé = b(i) End Function اظهار الاعمدة Sub Show_all_columns() Sheets("Sheet1").Columns("C:P").EntireColumn.Hidden = False End Sub بطريقة اخرى Sub Hide_columns() Dim Clé As Variant, desWS As Worksheet, rng As Range Set desWS = ThisWorkbook.Sheets("Sheet1"): Clé = [R1].Value If Clé > 0 Then With desWS Set rng = .Rows(7).Find(Clé, LookIn:=xlValues, lookat:=xlWhole) If Not rng Is Nothing Then Application.ScreenUpdating = False .Columns("C:P").EntireColumn.Hidden = True rng.EntireColumn.Hidden = False .Columns("E:F").EntireColumn.Hidden = False Else MsgBox "مادة" & " " & Clé & " : " & " غير موجودة ", vbExclamation: Exit Sub End If End With End If ActiveWindow.ScrollColumn = 1 Application.ScreenUpdating = True End Sub صفحة الرصد V2.xlsm
    3 points
  39. وعليكم السلام ورحمة الله تعالى وبركاته لجلب الصور دفعة واحدة يكفي الوقوف بمؤشر الماوس على اول خلية فارغة على عمود الصور وتشغيل الكود التالي مع تحديد الصور المرغوب اظافتها Sub InsertMultiplePictures() 'اظافة الصور' Set WS = Sheets("ادخال البيانات") Dim Pictures() As Variant Dim j As String, Rng As Range, Cpt As Shape On Error Resume Next Pictures = Application.GetOpenFilename(j, MultiSelect:=True) a = Application.ActiveCell.Column If IsArray(Pictures) Then Col = Application.ActiveCell.Row For lLoop = LBound(Pictures) To UBound(Pictures) Set Rng = Cells(Col, a) Set Cpt = WS.Shapes.AddPicture(Pictures(lLoop), msoFalse, msoCTrue, Rng.Left, Rng.Top, Rng.Width, Rng.Height) Col = Col + 1 Next End If End Sub لافراغ عمود الصور Sub DeleteImage() Dim pic As Picture Set f = Sheets("ادخال البيانات") For Each pic In WS.Pictures If Not Application.Intersect(pic.TopLeftCell, f.Range("G6:G200")) Is Nothing Then pic.Delete End If Next pic End Sub الجدول 1 =INDEX('ادخال البيانات'!$B$6:$G$2000;MATCH('طبع البيانات'!$C$10;'ادخال البيانات'!$B$6:$B$2000;0);6) =MyPicture الجدول 2 =INDEX('ادخال البيانات'!$B$6:$G$2000;MATCH('طبع البيانات'!$C$36;'ادخال البيانات'!$B$6:$B$2000;0);6) =MyPicture2 واخيرا ربط الصور بالنطاق الجمعيه الخيريه 2.xlsb
    3 points
  40. وعليكم السلام ورحمة الله تعالى وبركاته Private Sub TextBox1_Change() Dim a As Variant, b As Variant, Clé$, Rng As Range, i&, j&, k&, m& Dim WS As Worksheet: Set WS = Worksheets("donnes") Dim desWS As Worksheet: Set desWS = Worksheets("search") Clé = "*" & desWS.[B3].Value & "*" Set Rng = desWS.Range("A6:G" & Rows.Count) a = WS.Range("D5", WS.Range("J" & Rows.Count).End(3)).Value If Me.TextBox1 = "" Then Rng.ClearContents Else Application.ScreenUpdating = False With desWS On Error Resume Next .AutoFilterMode = False ReDim b(1 To UBound(a, 1), 1 To UBound(a, 2)) For i = 1 To UBound(a, 1) For j = 1 To UBound(a, 2) 'Filter by Uppercase and lowercase letters If LCase(a(i, j)) Like Clé Or UCase(a(i, j)) Like Clé Then k = k + 1 For m = 1 To UBound(a, 2) b(k, m) = a(i, m) Next Exit For End If Next Next Rng.ClearContents: Range("A6").Resize(k, UBound(b, 2)).Value = b Range("d6:d" & Rows.Count).NumberFormat = "dd-mm-yyyy" End With End If Application.ScreenUpdating = True End Sub بحث VBA V2.xlsm
    3 points
  41. شكرا لك استاذ حسان على الشرح الوافي الكافي و هي فكرتك الأولى ولعلك نسيت اضافة الجدول المحلي ضمن واجهة المستخدم لأن كتابة المقارنة بهذه الطريقة ستعمل لمرة واحدة فقط : 'يتأكد هل فيه نسخة مختلفة If Me.VerNo <> "001" Then ' =====> في كل مرة تقوم بتحدسث النسخة يجب تعديل الاصدار هنا وفي حقل الجدول xVer MsgBox "يوجد اصدار أحدث", 48 + 524288, "تحديث النسخة" واذا سمحت لي باضافة صغيرة : الجدول xver هذا على قاعدة البيانات في السيرفر وهو من سيحمل الرقم الجديد و يوجد جدول (محلي) على واجهة المستخدم يحمل الرقم القديم عند فتح واجهة المستخدم يقارن بين الرقمين في الجدولين .. فإن اختلفا يتم تشغيل التحديث ...... ويتم ايضا تحديث الجدول المحلي بالرقم الجديد /// وبما ان النسخة جديدة يكون المطور هو من وضع الرقم الجديد في الجدول المحلي فلا حاجة للتحديث . ليصبح كود المقارنة بما يشبه هذا : If VerNo1 <> VerNo2 Then
    3 points
  42. مشاركة مع الاخ @Foksh Option Compare Database Option Explicit Private Sub Command0_Click() ExecuteIfChromeOpen End Sub Function IsChromeRunning() As Boolean Dim strCommand As String Dim strOutput As String Dim objWShell As Object Set objWShell = CreateObject("WScript.Shell") strCommand = "tasklist /FI ""IMAGENAME eq chrome.exe""" strOutput = objWShell.Exec(strCommand).StdOut.ReadAll If InStr(strOutput, "chrome.exe") > 0 Then IsChromeRunning = True Else IsChromeRunning = False End If Set objWShell = Nothing End Function Sub ExecuteIfChromeOpen() If IsChromeRunning() Then MsgBox " المتصفح كروم قيد التشغيل. سيتم تنفيذ الأمر", vbInformation, "تأكيد" DoCmd.OpenForm "البيانات" Else MsgBox "يجب فتح المتصفح .", vbExclamation, "المتصفح مغلق" End If End Sub واليك المرفق بالتوفيق Database313.accdb
    3 points
  43. لم يكن خطا برمجي كل ما هنالك بعض السجلات مكررة للرقم
    3 points
  44. تفضل اليك الحلول التالية Sub ترحيل1() Dim Cpt As Long, Arr As Range, r As Range Dim a As Worksheet: Set a = Worksheets("Home"): Dim F As Worksheet: Set F = Worksheets("data") Cpt = F.Cells(F.Rows.Count, "B").End(xlUp).Row With Application .Calculation = xlManual .ScreenUpdating = False b = Array(a.[B2], a.[B3]): c = a.[F5] d = Array(a.[B4], a.[B5], a.[D2], a.[D3], a.[D4], a.[D5], a.[F2], a.[F3], a.[F4]) '***لعدم الترحيل في حالة العثور على خلية فارغة*** 'Set Arr = Union(a.[B2:B5], a.[D2:D5], a.[F2:F5]) ' For Each r In Arr ' If IsEmpty(r.Value) Or r.Value = vbNullString Then ' MsgBox " المرجوا ملء بيانات " & r.Offset(0, -1).Value, vbExclamation, "إنتباه" ' Exit Sub ' End If ' Next r '************************************************ F.Cells(Cpt + 1, "A") = F.Cells(Cpt + 1, "A").Row - 2 F.Cells(Cpt, "B").Offset(1).Resize(, 2).Value = b F.Cells(Cpt, "E").Offset(1).Resize(, 9).Value = d F.Cells(Cpt, "O").Offset(1).Value = c .Calculation = xlAutomatic .ScreenUpdating = True End With MsgBox "تم ترحيل البيانات بنجاح", vbInformation End Sub او Sub ترحيل2() Dim Cpt As Long Dim a As Worksheet: Set a = Sheets("Home"): Dim F As Worksheet: Set F = ThisWorkbook.Sheets("data") Cpt = F.Cells(F.Rows.Count, "B").End(xlUp).Row + 1 With Application .Calculation = xlManual .ScreenUpdating = False Arr = Array(a.[B2], a.[B3], a.[B4], a.[B5], a.[D2], a.[D3], a.[D4], a.[D5], a.[F2], a.[F3], a.[F4], a.[F5]) For I = 0 To 11 If Arr(I) = Empty Then MsgBox " المرجوا ملء بيانات " & Arr(I).Offset(0, -1), vbExclamation, "إنتباه" Exit Sub End If Next F.Cells(Cpt, "A") = F.Cells(Cpt, "A").Row - 2 F.Cells(Cpt, "B").Value = a.[B2].Value: F.Cells(Cpt, "G").Value = a.[D2].Value F.Cells(Cpt, "C").Value = a.[B3].Value: F.Cells(Cpt, "H").Value = a.[D3].Value F.Cells(Cpt, "E").Value = a.[B4].Value: F.Cells(Cpt, "I").Value = a.[D4].Value F.Cells(Cpt, "F").Value = a.[B5].Value: F.Cells(Cpt, "J").Value = a.[D5].Value F.Cells(Cpt, "K").Value = a.[F2].Value: F.Cells(Cpt, "L").Value = a.[F3].Value F.Cells(Cpt, "M").Value = a.[F4].Value: F.Cells(Cpt, "O").Value = a.[F5].Value .Calculation = xlAutomatic .ScreenUpdating = True End With MsgBox "تم ترحيل البيانات بنجاح", vbInformation End Sub 2024-3-15 ترحيل V2.xlsm
    3 points
  45. اول مرة يمر علي برنامج حسابات يتم الحذف بالجملة غالبا يتم حذف سجل واحد او اثنين بالكثير تم ادراجه بالخطأ . ويوضح سبب الحذف في حقل خاص في برامج الحسابات الاحترافية يتم الحذف وهمي فقط .. ولا يظهر بتاتا في السجلات ولا المجاميع .. ولكنه باقي في سجلات الجدول الفكرة انه قد يحتاج الرجوع اليه
    2 points
  46. وعليكم السلام ورحمة الله تعالى وبركاته Sub ÊÑÍíá2() Dim Ws As Worksheet, F As Worksheet Dim X As Long, I As Long, Arr Set Ws = Sheets("Home"): Set F = Sheets("data") X = F.Cells(Rows.Count, 2).End(3).Row + 1 Application.ScreenUpdating = False Arr = Array("B2", "B3", "", "B4", "B5", "D2", "D3", "D4", "D5", "F2", "F3", "F4", "", "F5") For I = LBound(Arr) To UBound(Arr) If Arr(I) <> "" Then Arr(I) = Ws.Range(Arr(I)).Value Next I F.Cells(X, 2).Resize(, UBound(Arr) + 1) = Arr F.Range("D3:D" & F.Range("B" & Rows.Count).End(3).Row) = "=($D$1-C3)/(365)" F.Range("N3:N" & F.Range("B" & Rows.Count).End(3).Row) = "=sum(k3+l3+m3)" F.Cells(X, 1) = F.Cells(X, 1).Row - 2 Application.ScreenUpdating = True End Sub او Sub ترحيل3() Dim Ws As Worksheet, F As Worksheet Dim X As Long, I As Long, Arr Set Ws = Sheets("Home"): Set F = Sheets("data") X = F.Cells(Rows.Count, 2).End(3).Row + 1 Application.ScreenUpdating = False Arr = Array("B2", "B3", "", "B4", "B5", "D2", "D3", "D4", "D5", "F2", "F3", "F4", "", "F5") For I = LBound(Arr) To UBound(Arr) If Arr(I) <> "" Then Arr(I) = Ws.Range(Arr(I)).Value Next I F.Cells(X, 2).Resize(, UBound(Arr) + 1) = Arr With F.Range("A3:A" & F.Range("B" & Rows.Count).End(xlUp).Row) .Formula = "=IF(B3="""","""",IF(B3=""Name"",""Count"",N(A2)+1))" .Value = .Value With F.Range("D3:D" & F.Range("B" & Rows.Count).End(3).Row) .Formula = "=($D$1-C3)/(365)" .Value = .Value With F.Range("N3:N" & F.Range("B" & Rows.Count).End(3).Row) .Formula = "=sum(k3+l3+m3)" .Value = .Value End With End With End With Application.ScreenUpdating = True End Sub 2024-3-15 ترحيل بيانات 2.xlsm
    2 points
  47. جرب هذا الكود التالي:- Private Sub YourButton_Click() ' الكود الذي تريد عرضه Dim codeText As String codeText = "DLookup(""result"", ""test_order_tbl"", ""[test] = ' & T & ' And [ID] = [Forms]![visit_frm]![ID]"")" ' عرض الكود في مربع النص Me.YourTextBox.Value = codeText End Sub للعدم تواجدي أمام الكمبيوتر حالياً ، استبدل اسم الزر واسم مربع النص في نموذجك 😊
    2 points
×
×
  • اضف...

Important Information