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

السلام عليكم ورحمة الله تعالى وبركاته اخوانى الكرام كنت قد وعدتك بمرفق اكسس يقوم بعمل الاتى انشاء اتصال بالسيرفر تلقائيا شرط ان تكون البيانات المدخلة صحيحة ربط الجداول تلقائيا من سيكوال الى اكسس فقط اكتب اسم الجدول فى سيكول وماذا تريد ان يكون اسمه فى اكسس ثم اضغط ربط وهذه صورة منه املا بيانات السيرفر واختار قاعدة البيانات واكتب اسم الجدول فى سيكوال واكتب اسم الجدول فى اكسس يعنى لما تربط الجدول هيظهر باسم ايه فى اكسس واختار ربط .. سيتم ربط الجدول او اذا كنت تمتلك قاعدة بيانات مربوطة مسبقا ونقلتها الى جهاز اخر فقط املأ بيانات السيرفر الصحيحة واختر انشاء اتصال فقط ليتم ربط جهازك بجهاز السيرفر ملحوظة اخيرة قمت بحويل الملف الى MDE فقط مؤقتا وسيتم ادراج الاكواد لاحقا شكرا لكم وهذا فيديو لطريقة العمل https://recordit.co/9oo8dmn3vG والان مع المرفق SqlConnect.rar

السلام عليكم ورحمة الله تعالى وبركاته أساتذتي وإخوتي الكرام تحية طيبة لكم وبعد ... بعد إنقطاع طويل عن المنتدى بسبب عدة ظروف أعود لكم بهذه الهدية المتواضعة أتمنى ان تنال استحسانكم البرنامج المرفق فريد من نوعه نوعاً ما فهو عبارة عن اضافة بيانات شخص مع صورته حيث يتم تخزين صورة الشخص في الجدول كبيانات ثنائية طويلة (binary long data) كما يمكنك استعراض الصورة وتغييرها ايضاً قد يتسائل البعض عن أهمية استخدام هذه الطريقة في حفظ الصور!! ولماذا لا نقوم بحفظ الصور خارج قاعدة البيانات فقط وربطها بالبرنامج؟ الجواب ببساطة هو انني قد واجهت مشكلة في استعمال برنامج لإصدار بطاقات تعريفية للموظفين حيث ان البرنامج يقرأ بيانات الموظفين من قاعدة بيانات اكسس وعند اضافة صورة الموظف يقوم بتخزينها في القاعدة بصيغة بيانات ثنائية طويلة كما يقرئها بنفس الصيغة ايضاً ولا يتعامل مع الصور المرتبطة في الجدول ولضعف امكانيات البرنامج في ادخال البيانات والبحث عنها وفلترتها اضطررت الى انشاء برنامج يدخل البيانات الى تلك القاعدة وفلترتها وما الى ذلك ومن هنا وجدت انني لابد من تمكين برنامجي من اضافة الصور الى الجدول بنفس الصيغة والتحكم بها وتغييرها في اي وقت دون الحاجة الى عمل ذلك من خلال برنامج اصدار البطاقات التعريفية. على العموم اتمنى ان يستفاد منه احد في مشاريعه تحياتي view_add_edit_binary_image.mdb

السلام عليكم 🙂 اخي ابو بشري ، المنتدى موجود لتبادل الخبرات ، والانتقال الى محادثة خاصه تحرم الجميع من الاستفادة من الاجابه. جعفر

فى البداية اوجه الشكر لكم وانوه ان هذا الموضوع هو تكملة للموضوع التالى الخاص بتحويل الاكسس الى سيكوال انشاء السيرفر وتحويل اكسس الى سيكوال اى انـــــه لابد من تثبيت السيرفر اولا فقط على الجهاز الذى سيكون عليه قاعدة البيانات وتحويل قاعدة البيانات من اكسس الى سيكوال لكى يتم الاتصال بشكل فعلى هنا يعنى هنثبت سيكوال فقط على جهاز السيرفر مش كل الاجهزةة كلانا يعرف كيفية مشاركة الاكسس على الشبكة المحلية فقط هنعمل مشاركة للمجلد الذى يحتوى على قاعدة البيانات وبكدا اى مستخدم على الشبكة المحلية يقدر يستخدم قاعدة بيانات اكسس الموضوع يختلف كثير مع سيكوال تعالو لنقسم الموضوع الى جزئين الاتصال عن طريق الشيكة المحلية الاتصال عن طريق الانترنت 1 - فتح بورت فى الويندوز 1 - فتح بورت فى الويندوز 2 - فتح بورت فى السيرفر 2 - فتح بورت فى السيرفر 3- تثبيت الاى بى للويندوز 3 - فتح بورت فى الراوتر 4 - الحصول على اى بى ثابت اولا الاتصال عن طريق الشبكة المحلية ------------------------------------------------ بعد نثبيت السيرفر وتحويل الاكسس الى سيكوال اى تصدير الجداول من اكسس الى قاعدة بيانات سيكوال هناك امور مشتركة بين الاتصالين وهو فتح بورت فى الويندوز وفتح بورت فى السيرفر اذا نبدأ فى شرح كيفية فتح بورت فى الويندوز عن طريق Windows Firewal كدا فتحنا بورت لسيكوال سيرفر فى النظام طبعا لو عندك برامج حماية غير windows Defender يجب ان تسمح له بفتح البورت ------------------------------------------------------------------------------------------------------------------------------------------------------------------------------- والان فتح بورت فى السيرفر كدا فتحنا بورت فى السيرفر نيجى بقى للاتصال من جهاز اخر غير جهاز السيرفر تابع معى اولا يجب معرفة اى بى جهاز الذى عليه السيرفر عن طريق Cmd ثم ipconfig هيظهر الاى بى فى IPv4 Adress اما الثانية فدا عنوان الراوتر طبها الاى بى الخاص بجهاز السيرفر هو 192.168.1.3 وهذا الذى سوف نتصل به من الكمبيوتر الاخر الذى على نفس الشيكة المحلية هنفتح ODBC زى ما عملنا فى الموضوع السابق والخطوة الاهم هى التالية هنكتب اسم قاعدة البيانات اسم السيرفر سيكون كاالتالى الاى بى الخاص بالسيرفر , بورت السيرفر ( 1433 ) كوما وليس نقطة (192.168.1.3,1433 ) وتكمل خطواتك عادى زى الموضوع السابق بقى وبكدا يبقى اتصلنا بجهاز السيرفر ونستطيع نعمل ارتباط لجداول قاعدة البيانات من سيكوال الى اكسس حاجة اخيرة الاى بى الخاص بجهاز السيرفر بيتغير كل شوية ممكن نثبته عن طريق الخطوات التالية هنجيب الاى بى من cmd كدا احنا ثبتنا الاى بى الخاص بالجهاز اللى عليه السيرفر علشان تقدر تدخل بيه من على اى جهاز ------------------------------------------------------- المرحلة الثانية الاتصال بالسيرفر من على النت اى ليس شرطا وجودالمتصل على نفس الشبكة المحلية هى هى نفس الخطوات فقط هنضيف خطوة زيادة الا وهى الحصول على Static IP وفتح بورت فى الراواتر بالنسبة للاى بى الثابت دى خدمة بتقدمها الشركة اللى انت متعاقد معاها على خط الانترنت فى مصر تكلفة الاى بى الثابت عشرة جنيه شهريا من We بتطلبه من الشركة وهى بتثبتلك اى بى عمتا لو عاوز تعرف الاى بى بتاعك تابع الاتى مع العلم ان الاى بى بتغير كل ما تعمل ريستارت للراوتر هتبحث فى جوجل كدا ويطلعلك الاى بى كدا ودا اللى هنقدر ندخل بيه على السيرفر من اى مكان شرط توافر انترنت طبعا مش هتقدر تتصل على السيرفر بالاى بى دا اللى لما تفتح بورت فى الراوتر اللى متصل عليه السرفر تابع معايا انا عندى راوتر تى داتا وهشرح عليه تقريبا هى نفس الخطوات فى كل الروترات فتح بروت فى الراوتر طبعا هتعرف عنوان الراوتر بتاعك من هنا والاى بى اللى هنستخدمه هندخل على المتصفح ونكتب فى عنوان الراوتر وندخل عليه طبعا الاسم وكلمة السر بيبقى موجودين على ضهر الراوتر بعد كدا نفس الخطوات بالظبط كدا يبقى فتحنا البورت فاضل اللاتصال طبعا هتفتح ODBC ذى ما ذكرنا قبل كدا وهتدخل البيانات زى كدا الاى بى , 1433 وتابع بقية الخطوات زى الموضوع السابق علشان تقدر تحضر قاعدة بيانات سكوال على جهازك وتتصل عليه طبعا الشغل اللى مطلوب على جهاز السيرفر الحصول على الى Static IP فى حالة الاتصال عن بعد فتح بورت فى الرواتر فى حالة الاتصال عن بعد تثبيت اى بى الجهاز فتح بورت فى الويندوز فتح بورت فى السيرفر بعد ما تعمل كل دا انت ما عليك الا انك تتصل على السيرفر كما ذكرت دون الحاجة الى تثبيت سيكوال سيرفر على جهازك شكرا لكم كان مفروض فى مرفق بتدخله بيانات السيرفر زى اى بى اسم قاعدة البيانات سيكوال اسم المستخدم لو فى وكلمة السر للسيرفر وهو هينشأ الاتصال اوتامتيك طبعا بعد ما تظبط جهاز السيرفر زى ما قلنا وفى نفس المرفق خيار اخر وهو هتدخل البيانات السابقة اضافة الى اسم جدول موجود على سيكول وهو هيربطهولك تلقائى فى قاعدة اكسس بس الوقت اتاخر اوى وانا بسقط من النوم الصراحة ان شاء الله نقوم بتصميمه غدا السلام عليكم ورحمة الله وبركاته اخوكم السيد جمال 🥰

شكرا لك اخي خالد 🙂 في طريقة اخرى ، باستخدام الامر instr داخل الاستعلام ، متعبة بعض الشيء ، وقد بدأت العمل عليها ، ولكني اريد بيانات حقيقية للتجربة عليها ، ويكون جدا صعب تغيير العمل اذا كانت البيانات بطريقة غير!! شوف الاستعلامات qry_1 و qry_2 و qry_3 ، وطبعا لازم اكملها لبقية الحقول 🙂 طيب ، لوسمحت ابو عبد الله ، اعطينا بعض الكلمات الحقيقة اللي عندك ، ويا ريت في جدول في الاكسس ، علشان نشوف كيف نقدر نحل الموضوع 🙂 والسبب في طلب بيانات حقيقية ، هي ان الجواب يكون تفصيل خاص لطريقة عرض كلماتك. جعفر 1116.1.Split.mdb

جرب الملف المرفق .. ميزة الطريقة الموجودة في المرفق هي عند اخفاء الجداول فلايمكن اظهارها من خلال خيارات العرض في قاعدة البيانات "إظهار الكائنات المخفية" كما لايمكن استيراد الجداول ايضاً example1.accdb

أ.اسلام سيد مش عارف انا فهمت صح ولا غلط جرب المويول 'للإخفاء Public Function ESHideTables() Dim dbs As dao.Database Dim tbl As dao.TableDef Dim qry As dao.QueryDef Dim str As String On Error Resume Next Set db = CurrentDb() For Each tbl In db.TableDefs Application.SetHiddenAttribute acTable, tbl.Name, True Next tbl End Function والموديول الثانى 'للإظهار Public Function ESShowTables() Dim dbs As dao.Database Dim tbl As dao.TableDef Dim qry As dao.QueryDef Dim str As String On Error Resume Next Set db = CurrentDb() For Each tbl In db.TableDefs Application.SetHiddenAttribute acTable, tbl.Name,Fales Next tbl End Function وقم بإستاعائهم عن طريق Call ESHideTables للإخفاء أو Call ESShowTables للإظهار أرجو أن أكون وفقت بالتوفيق

وعليكم السلام 🙂 اذا كان الحقل IDStu رقم: mySQL = "Select * From Query2" mySQL = mySQL & " WHERE IDStu Between " & [Forms]![X1]![A1] & " And " & [Forms]![X1]![A2] Set rst = CurrentDb.OpenRecordset(mySQL) rst.MoveLast: rst.MoveFirst بينما اذا كان الحقل IDStu تاريخ: mySQL = "Select * From Query2" mySQL = mySQL & " WHERE IDStu Between #" & [Forms]![X1]![A1] & "# And #" & [Forms]![X1]![A2] & "#" Set rst = CurrentDb.OpenRecordset(mySQL) rst.MoveLast: rst.MoveFirst جعفر

يمكنك تجربة هذا الموقع سيفيدك فى حل هذه المشكة عن طريق عمل نسخ للعمود المعكوس ولصقه فى هذا الموقع لعلاجه ثم اخذ ما تم بعد ذلك ولصقه فى ملفك https://omar84.com/docs/taw/arabic_writer.html تجربة 1.xlsm

السلام عليكم ورحمة الله وبركاته انا احد الاشخاص الذين لا يحبذ ان يستعمل الكود في تخفيف أمان الاكسس ، فقد وضعته شركة مايكروسوفت في حزمة الاوفيس حتى تحمينا من ايدي المخربين ، وفي هذا الرابط شرحت كيفية عمل مجلد موثوق به للأكسس 2007 فما فوق: http://www.officena.net/ib/topic/66450-دمج-ملف-وتشغيله-قبل-أو-مع-بدء-اكسس/#comment-432363 المشكلة في كود تخفيف الامان ، انه لا يخفض مستوى أمان الاكسس لبرنامجك فقط ، وانما يخفض مستوى أمان جميع برامج الاكسس. ولكننا كمبرمجين لدينا مشكلتنا ، في انه اذا ارسلت برنامجك الى شخص ما ، فلا بد من التواصل معه و اعطاؤه الخطوات كما في الرابط ، وإلا فالبرنامج لن يعمل ، لان البرنامج يشتمل على الماكرو والوحدات النمطية. هنا اقدم لكم طريقة لجعل برنامجي فقط يعمل بمستوى أمان أقل ، فلا تظهر لي رسالة الأمان من الاكسس. العمل كله يدور حول كود ، ويجب حفظ الكود هذا في ملف بصيغة vbs ، والذي يجب ان نفتح برنامجنا عن طريقه. الكود يعمل على برامج الاكسس بصيغة mdb و accdb ، والمفروض ان يعمل على جميع اصدارات الاكسس 2003 فما فوق ، وعلى الاكسس 32بت و64بت (انا هنا اطلب من الشباب تجربته بإصدارات الاكسس التي يعملون عليها ، وإخبارنا بالنتيجة لوسمحتوا). اليكم طريقة العمل (رجاء انزال المرفق وفكه في المسار C:\jj ، وذلك حتى يمكنكم متابعة خطواتي): رجاء وضع البرنامج المرفق Seq.mdb حسب المسار التالي: C:\jj\Seq.mdb الآن اذهب الى المجلد C:\jj وافتح البرنامج Seq.mdb بالنقر المزدوج ، عند فتحه نرى رسالة أمان الاكسس ، وهذا متوقع ، وذلك بسبب انه في مجلد غير موثوق به (رجاء لا تضف هذا المجلد كمجلد أمان ، وانما اخرج من البرنامج). . الملف الآخر المرفق Seq.vbs ، يحتوي على هذا الكود: rem http://www.accessmvp.com/jconrad/accessjunkie/macrosecurity.html rem expression.OpenCurrentDatabase(filepath required, Exclusive optional, bstrPassword optional) dim o set o=createobject ("Access.Application") o.automationsecurity=1 ' set macro security LOW. o.opencurrentdatabase "C:\jj\Seq.mdb" o.usercontrol=true set o=nothing . تستطيع ان تجعله في اي مجلد (ممكن تجرب نسخه منه في اي مجلد شئت) ، وانقر مرتين على هذا الملف بُغية تشغيله ، سترى انه فتح البرنامج Seq.mdb ، وبدون رسالة أمان الاكسس ، وهو المطلوب ------------------------------------------------------------------------------------------------------------------------------------------- هذه الخطوة إضافية ، وهي لتحويل الملف السابق من صيغة vbs الى exe ، واختيار ايقونه للملف الجديد الآن ننتقل للخطوة التالية ، وهي ، اننا لا نريد ان ايقونة vbs ، وانما نريد ايقونه خاصة لبرنامجنا. هناك طريقتين: 1. ايقونة مختصر البرنامج Shortcut: وهي ان نعمل مختصر لملف Seq.vbs ، ولكن وللأسف مختصر ملف vbs يعطينا نفس ايقونة الملف نفسه ، وما عندنا طريقة لتغييرها!! لذلك ، سنعمل مختصر لملف الاكسس ، ونغير البيانات كالصورة التاليه ، بحيث يصبح مختصر ملف vbs يحتوي على ايقونة ملف الاكسس (طبعا يمكنك ان تغير الايقونة الى اي شئ شئت): . . . . وبهذه الطريقة غيّرنا ايقونة برنامج vbs الى ايقونه اخرى مناسبة 2. تحويل ملف vbs الى ملف تنفيذي exe ، وتختار له الايقونة التي تعجبك: رجاء انزال البرنامج المجاني Vbs to Exe من الرابط التالي: http://www.f2ko.de/en/v2e.php احد اسباب اختياري لهذا البرنامج ، اننا نستطيع التحكم به عن طريق Commandline ايضا ثم نتبع الخطوات التالية: ونستطيع ان نعمل لبرنامج vbs هذا كلمة سر كذلك ، . في الخطوة 6 تستطيع ان تكتب معلومات شركتك ، ونختار الايقونه التي نريدها للبرنامج (الخطوة 5) . . وتستطيع ان تجعله على سطح مكتب كمبيوترك الميزة في هذه الطريقة ، ان المستخدم لن يعرف مكان برنامج قاعدة البيانات Seq.mdb ، ولن يعرف الكود الذي كان في Seq.vbs ارجو ممن يضع ردا على الموضوع ، ان يذكر: 1. اذا اشتغل البرنامج على كمبيوتره ، 2. نسخة الاكسس التي يستخدمها. ملاحظة: الظاهر ان بعض متصفحات الانترنت حجبت انزال المرفق Seq.zip ، وذلك بسبب احتوائه على ملف vbs ، والذي يستخدمه الكثيرون لتخريب الكمبيوتر ، لذلك ، ارفق لكم Seq_2.zip والذي يحتوي على نفس ملفات Seq.zip ، ولكني غيرت صيغة الملف Seq.vbs الى Seq.txt . بعد انزال المرفق وفك ملفاته في الكمبيوتر ، رجاء تغيير مسمى الملف Seq.txt الى Seq.vbs جعفر Seq.zip Seq_2.zip

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

السلام عليكم اساتذتى الافاضل لمشاركتكم والتعلم ايضا معكم مثلما قال استاذ جعفر مرهقه وطويله وقمت باستخدام الداله mid & instr & right هذا ما تم عمله من قبل استاذى خالد فى استعلام 1 واستعلام 2 ما قد عملته وطبعا لم اكمل بقيته لانه مرهق بصراحه وطبعا اخى ابو عبدالله لا يريد استخدام الموديول وطبعا باستخدام بعض البحث Database591(3).accdb

بعد اذن اخي العيدروس هذه المعادلة (Ctrl+Shift+Enter) =IFERROR(--MID(D6,MAX(IF(MID(D6,ROW(INDIRECT("1:"&LEN(D6))),1)="-",ROW(INDIRECT("1:"&LEN(D6)))+1)),LEN(D6)),"") Booook1.xlsx

السلام عليكم 🙂 شوف الاستعلام qry_Split جعفر 1116.Split.mdb.zip

في الغالب يتم استخدام الاستعلامات بالكود عن طريق تحويل الاستعلام العادي الى كود وعند قفل الأكواد برقم سري وتحويل قاعدة البيانات الى mde او accde فانك سوف تحمي جميع الاكواد بمافي ذلك الوحدات النمطية .. بالنسبة للكود السابق فهو مجهز للجداول فقط ولا اعلم ما اذا كان يمكن تطبيق نفس فكرته على الاستعلامات العادية تحياتي

السلام عليكم بارك الله فيك استاذ سليم استخدام رائع للـ Regex بالامكان نستخدم كودك الرائع كمعادلة Function SPLIT_ME(c, Optional pttrn As String = "\D+-\d+-\d+\s+?\d+:\d+") With CreateObject("VBscript.RegExp") .Pattern = pttrn: SPLIT_ME = .Execute(c.Value)(0) End With End Function تقبل تحياتي وشكري

ممكن هذا الماكرو لمختلف الحلات دون التقيد بعدد الحروف حيث يبدأ البحث Option Explicit Sub Extract_Date_Please() Dim i%: i = 1 Range("C1").CurrentRegion.ClearContents Do Until Range("A" & i) = vbNullString Call SPLIT_ME _ (Range("a" & i), "\D+-\d+-\d+\s+?\d+:\d+", i, 3) i = i + 1 Loop End Sub '+++++++++++++++++++++++++++++++ Sub SPLIT_ME(c As Range, pttrn As String, k%, m%) With CreateObject("VBscript.RegExp") .Global = True: .MultiLine = True .IgnoreCase = False: .Pattern = pttrn If Not .Test(c.Value) Then Exit Sub Cells(k, m) = .Execute(c.Value)(0) m = m + 1 End With End Sub مثال للتوضيح في الملف المرفق Extract_dates.xlsm

تفضل etudiant2021.xlsm

هذا معناه انه لا توجد سجلات بين هذين الرقمين 🙂 استعمل هذه الطريقة للتخلص من هذه الرسالة: private sub abc_click() on erroro goto err_abc_click dim rst as dao.recordset mySQL = "Select * From Query2" mySQL = mySQL & " WHERE IDStu Between " & [Forms]![X1]![A1] & " And " & [Forms]![X1]![A2] debug.print mySQL 'حتى نرى الجملة كاملة في اسفل الشاشة، ونستطيع لصقها في الاستعلام حتى نرى النتيجة هناك Set rst = CurrentDb.OpenRecordset(mySQL) rst.MoveLast: rst.MoveFirst Exit_abc_click: rst.close: set rst=nothing exit sub err_abc_click: if err.number=3021 then 'no records resume Exit_abc_click else msgbox err.number & vbcrlf & err.description end if end sub جعفر

أيوه كده تكون الإستجابة سريعة بالملف-تفضل تم التعديل بارك الله فيك -يمكنك تتبع ذلك بنفسك فقد تم عمل كود جديد وتغيير تكست بوكس الكود , وعمل كمبوبوكس للأكواد ليسهل عملية الإدخال عند اختيار الكود وليس كتابته vlookup2.xlsm

وعليكم السلام ورحمة الله وبركاتة شاهد التعديل فقط على اي حدث تستدعي فيه الـ ListBox 2009.xlsm

أ.عبدالعزيز محمد أولا قم بربط الجدول الذى به بيانات بقاعدة البيانات التى سيتم الإستيراد إليها (ربط وليس إستيراد) ثانيا قم بعمل إستعلام إضافة وإختر إسم الجدول الذى إدراج البيانات به شغل الاستعلام .. سيتم للإدراج الى الجدول بنجاح إذا كانت جميع الحقول متشابهة إسما ونوعا إنشئ مجلد جديد وسمه Test على المحرك D وضع به المرفقين شغل ملف Aziz افتح جدول TabSudents2 للتأكد من أنه فارغ شغل الإستعلام .. افتح جدول TabSudents2 مرة أخرى للتأكد من أنه تم الإستيراد أرجو أن يكون المطلوب بالتوفيق Aziz.accdb Aziz2.accdb

السلام عليكم اسعد مساك اخي سعد عابد كيف صحتك ان شاء الله تكون بصحة وسلامه بالامكان عبر هذه المعادلة المعرفة Function Ali_Sp(D) Dim A Dim i, x, E A = Sheets("الاسعار").Range("B6:D500").Value For i = LBound(A, 1) To UBound(A, 1) If A(i, 2) = D Then E = A(i, 3) E = Split(A(i, 3), "-") x = UBound(E) Ali_Sp = E(x) Exit For End If Next i End Function او عبر هذا الكود Sub Ali_S() Dim A Dim x, i, E, R A = Sheets("الاسعار").Range("B6:D500").Value For i = LBound(A, 1) To UBound(A, 1) For R = 5 To Cells(Rows.Count, "B").End(xlUp).Row If A(i, 2) = Cells(R, "B") Then E = A(i, 3): E = Split(A(i, 3), "-") x = UBound(E): Cells(R, "C") = E(x) End If Next R Next i End Sub

وعليكم السلام اخوي ابو زاهر 🙂 للأسف الشديد ما عندي فكرة !! يمكن احد من الشباب صادف هذه المشكلة ، ويعطينا الحل 🙂 جعفر

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

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

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

ممكن أنا أيضا أكون فاهم غلط 😉

اخي ابو عيد سبق وان جربت هذه الطريقة اولا تفتح الواتس من جوالك وتتركه مفتوح عند البدء بتطبيق الكود ثانيا تسجيل الدخول على واتس الويب https://web.whatsapp.com/ عبر المتصفح وتقراء الباركود من جوالك "واتس ويب" لاعتماد دخول الواتس من نفس الجهاز وتسجيل الاسماء او الارقام في القائمة اذا سجلت اسماء ضروري تسجل نفس الاسم المسجل في جوالك يقوم الكود بفتح رابط الواتس عبر المتصفح والبحث عن الاسم او الرقم ويرجع ينسخ الرسالة ويحطها بمربع كتابة الرسائل وينقر ارسال وهكذا يكرر العملية اذا سجلت اكثر من اسم

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

السلام عليكم جرب المرفق المكملون مع الدرجة Ali_1.xlsm

وعليكم السلام -تفضل فقط يمكنك استخدام هذه المعادلة =((E3*F3)*12)+(E3*G3)+((H3/30)*E3) التاريخ1.xlsx

علم على الثلاث خلايا بالماوس اذهب الى التنسيق الشرطى فى القوائم الاعلى سترى ماحدث

أحسنت استاذنا الكريم عمل ممتاز وشرح مستفيض بارك الله فيك وزادك الله من فضله

وعليكم السلام-جرب هذا الملف فيه طلبك Create-Hyperlinked-List-of-Files-in-Subfolders.xlsm

السلام عليكم في هاتين الخليتين (ذكور - إناث) أبدل الجزئية 1 - بـ 3 - مثل ما فعلت في المرفق... بن علية حاجي 123.xls

وعليكم السلام ورحمة الله وبركاته تم عمل وحدة نمطية لاستدعاء رابط الصورة في أي مكان سواء كان نموذج او تقرير وفي حدث الحالي او التحميل او الفتح Public Function DisplayImage(Imge As Control) As String On Error Resume Next Dim sImgPath As String Dim Pic As DAO.Recordset Dim Tbl As String Set dbs = CurrentDb Tbl = "SELECT * FROM [PicTable]" Set Pic = dbs.OpenRecordset(Tbl) sImgPath = Pic.Fields("PictureFld") '=====================She3araaat=================== If IsNull(sImgPath) Or sImgPath = "" Then Imge.Picture = "" Imge.Visible = False Else Imge.Visible = True Imge.Picture = sImgPath End If End Function يتم استدعاؤها هكذا: Call DisplayImage(Pic1) pic1 هو اسم التكست بوكس الخاص بمسار الصورة ويمكنك تغييره حسب المسار لديك الوحدات النمطية لفتح المستعرض للبحث عن الصورة كثيرة ومتعددة الاشكال وضعت لك وحدة استخدمها قديما وتفي بالغرض رغم ان هناك غيرها وبشكل مختصر تفضل المرفق Aziz.accdb

السلام عليكم ورحمة الله تم عمل المطلوب بإضافة عدة أعمدة (عمود الترتيب-عمود رقم التسجيل-عمود الصفة-عمود تاريخ الدخول-عمود تاريخ الخروج) في شيت التلاميذ... تم حذف أعمدة يومي الجمعة والسبت من جدولي ورقتي التلاميذ والأساتذة... مع تعديل كل المعادلات اللازمة... إذا كانت هناك اقتراحات أو تعديلات أخرى أستطيع عملها، إن شاء الله تجدونني في الخدمة.... كل الأوراق محمية بالكلمة السرية 123 ما عدا ورقة التوقيت T... بن علية حاجي 123.xls

عجبنى الموضوع ده قلت أشاركه معكم بإختصار هو سكريبت لعمل مكان موثوق لملفات الأكسيس من مكان تشغيله .. بمعنى لو شغلته من Desk Top تقدر تفتح أى ملف أكسيس على Desk Top بدون ظهور Enable Content. ولو عندك فولدر لمشاريعك فى أى مكان سواء سى أو دى أو .... ضع هذا السكريبت داخله وشغل وخلاص بقى كل ما بداخل الفولدر منطقة أمان. إنشئ ملف نص بأى إسم وضع فيه ما يلى على أن تغير إمتداده الى vbs. Const HKEY_CURRENT_USER = &H80000001 Dim oRegistry Dim sPath Dim sDescription Dim bAllowSubFolders Dim bAllowNetworkLocations Dim bAlreadyExists Dim sParentKey Dim iLocCounter Dim arrChildKeys Dim sChildKey Dim sValue Dim sNewKey Set WshShell = CreateObject("WScript.Shell") strCurDir = WshShell.CurrentDirectory Set oRegistry = GetObject("winmgmts:\\.\root\default:StdRegProv") sPath = strCurDir sDescription = "YourTrustedLocationDescriptionGoesHere" bAllowSubFolders = True bAlreadyExists = False sParentKey = "Software\Microsoft\Office\16.0\Access\Security\Trusted Locations" ' sParentKey = "Software\Microsoft\Office\16.0\Excel\Security\Trusted Locations" ' sParentKey = "Software\Microsoft\Office\16.0\PowerPoint\Security\Trusted Locations" ' sParentKey = "Software\Microsoft\Office\16.0\Word\Security\Trusted Locations" iLocCounter = 0 oRegistry.EnumKey HKEY_CURRENT_USER, sParentKey, arrChildKeys For Each sChildKey in arrChildKeys oRegistry.GetStringValue HKEY_CURRENT_USER, sParentKey & "\" & sChildKey, "Description", sValue If sValue = sDescription Then bAlreadyExists = True If CInt(Mid(sChildKey, 9)) > iLocCounter Then iLocCounter = CInt(Mid(sChildKey, 9)) End If Next 'If bAlreadyExists = False Then sNewKey = sParentKey & "\Location" & CStr(iLocCounter + 1) oRegistry.CreateKey HKEY_CURRENT_USER, sNewKey oRegistry.SetStringValue HKEY_CURRENT_USER, sNewKey, "Path", sPath oRegistry.SetStringValue HKEY_CURRENT_USER, sNewKey, "Description", sDescription If bAllowSubFolders Then oRegistry.SetDWORDValue HKEY_CURRENT_USER, sNewKey, "AllowSubFolders", 1 End If كما يمكن تفعيله للاكسيل والوورد والباور بوينت مع مراعاة نسخة الاوفيس لديك وتغيرها فى الكود: أوفيس 2019 : 16.0 أوفيس 2016 : 16.0 أوفيس 2013 : 15.0 أوفيس 2010 : 14.0 أوفبس 2007 : 12.0 أوفيس 2003 : 11.0 أظن أنه لا يوجد أحد أعضاء منتدانا الكريم يعمل على أوفيس XP 😊 عسى أن يفيد .. إذا اشتغل يعنى والله الموفق EAR TrustAnyWhere.zip

السلام عليكم ورحمة الله أسأل الله ان يزيدك علما وأن يحفظك من كل مكروه . جربت الكود المرفق ويعمل لدي بصورة رائعة وحيث ما وضعت الملف المرفق يجعل الأكسس يعمل بالرغم من ان مستوى الأمان مرتفع وهذا مستحيل سابقا . تحياتي وتقديري .

الملحوظة الأولي : تطبيق التلوين على المعادلات ايضا و ليس النصوص فقط ربما لا يمكن عمل ذلك ، و اتمني أن يجد الأخوة حل لهذا الأمر الملحوظة الثانية : تطبيق التلوين على ما يكتب من النصوص و ليس فقط عند تعديل الخلية C1 جرب التعديل البسيط التالي لكود الأخ وجيه Private Sub Worksheet_Change(ByVal Target As Range) Dim lr As Integer If IsEmpty(Range("c1")) Then Exit Sub lr = Range("b" & Rows.Count).End(xlUp).Row Range("b4:b" & lr).Font.ColorIndex = xlAutomatic For Each c In Range("b4:b" & lr) For i = 1 To lr If Mid(c.Value, i, Len(Range("c1"))) = Range("c1").Value Then c.Characters(i, Len(Range("c1"))).Font.Color = vbRed End If Next Next End Sub

هذا يبحث عن التاريخ المختار فقط

تفضل تم تعديل كود الطباعة كم تم عمل البحث بشرطين بمعادلات المصفوفة الشيت.xlsm

تفضل-أيوه كده لابد من التوضيح فى المطلوب لكى تتم الإستجابة order2.xlsm

تم عمل هذا فى العمود X من الصفحة الثانية AG__.xlsx

وعليكم السلام ضع هذا الكود فى حدث الصفحة Private Sub Worksheet_SelectionChange(ByVal Target As Range) If Not Application.Intersect(Target, Range("B7:B100")) Is Nothing Then UserForm1.Show End If End Sub

تفضل اخى الكريم -هذا الكود للتعطيل Sub Disable_Keys() Dim StartKeyCombination As Variant Dim KeysArray As Variant Dim Key As Variant Dim I As Long On Error Resume Next 'Shift key = "+" (plus sign) 'Ctrl key = "^" (caret) 'Alt key = "%" (percent sign 'We fill the array with this keys and the key combinations 'Shift-Ctrl, Shift- Alt, Ctrl-Alt, Shift-Ctrl-Alt For Each StartKeyCombination In Array("+", "^", "%", "+^", "+%", "^%", "+^%") KeysArray = Array("{BS}", "{BREAK}", "{CAPSLOCK}", "{CLEAR}", "{DEL}", _ "{DOWN}", "{END}", "{ENTER}", "~", "{ESC}", "{HELP}", "{HOME}", _ "{INSERT}", "{LEFT}", "{NUMLOCK}", "{PGDN}", "{PGUP}", _ "{RETURN}", "{RIGHT}", "{SCROLLLOCK}", "{TAB}", "{UP}") 'Disable the StartKeyCombination key(s) with every key in the KeysArray For Each Key In KeysArray Application.OnKey StartKeyCombination & Key, "" Next Key 'Disable the StartKeyCombination key(s) with every other key For I = 0 To 255 Application.OnKey StartKeyCombination & Chr$(I), "" Next I 'Disable the F1 - F15 keys in combination with the Shift, Ctrl or Alt key For I = 1 To 15 Application.OnKey StartKeyCombination & "{F" & I & "}", "" Next I Next StartKeyCombination 'Disable the F1 - F15 keys For I = 1 To 15 Application.OnKey "{F" & I & "}", "" Next I 'Disable the PGDN and PGUP keys Application.OnKey "{PGDN}", "" Application.OnKey "{PGUP}", "" End Sub وهذا لإرجاع الحال الى السابق والطبيعى اى لعمل الإختصارات مرة أخرى Sub Enable_Keys() Dim StartKeyCombination As Variant Dim KeysArray As Variant Dim Key As Variant Dim I As Long On Error Resume Next 'Shift key = "+" (plus sign) 'Ctrl key = "^" (caret) 'Alt key = "%" (percent sign 'We fill the array with this keys and the key combinations 'Shift-Ctrl, Shift- Alt, Ctrl-Alt, Shift-Ctrl-Alt For Each StartKeyCombination In Array("+", "^", "%", "+^", "+%", "^%", "+^%") KeysArray = Array("{BS}", "{BREAK}", "{CAPSLOCK}", "{CLEAR}", "{DEL}", _ "{DOWN}", "{END}", "{ENTER}", "~", "{ESC}", "{HELP}", "{HOME}", _ "{INSERT}", "{LEFT}", "{NUMLOCK}", "{PGDN}", "{PGUP}", _ "{RETURN}", "{RIGHT}", "{SCROLLLOCK}", "{TAB}", "{UP}") 'Enable the StartKeyCombination key(s) with every key in the KeysArray For Each Key In KeysArray Application.OnKey StartKeyCombination & Key Next Key 'Enable the StartKeyCombination key(s) with every other key For I = 0 To 255 Application.OnKey StartKeyCombination & Chr$(I) Next I 'Enable the F1 - F15 keys in combination with the Shift, Ctrl or Alt key For I = 1 To 15 Application.OnKey StartKeyCombination & "{F" & I & "}" Next I Next StartKeyCombination 'Enable the F1 - F15 keys For I = 1 To 15 Application.OnKey "{F" & I & "}" Next I 'Enable the PGDN and PGUP keys Application.OnKey "{PGDN}" Application.OnKey "{PGUP}" End Sub أتمنى الإفادة بارك الله فيك

تفضل Book1.xlsx

الأستاذ / أبو بهاء المصري السلام عليكم ورحمة الله وبركاته تم التعديل على ملف حضرتك وتم الحل بحل بطريقة أخرى.أرجو ان يكون المطلوب. SUMPRODUCT3.rar SUMPRODUCT44.rar

السلام عليكم الاخ الفاضل الجزيره هذا الكود في حدث Thisworkbook يمنع ادراج ورقة جديدة بالامكان استخدامه Private Sub Workbook_NewSheet(ByVal SH As Object) MsgBox "لقد تمت عملية إدراج الورقة بنجاح. ", vbInformation + vbMsgBoxRight + vbMsgBoxRtlReading Application.DisplayAlerts = False MsgBox "ولكن، لا يمكنك إدراج أي ورقة جديدة بهذا البرنامج. ", vbExclamation + vbMsgBoxRight + vbMsgBoxRtlReading ActiveSheet.Delete MsgBox "وقد تمت عملية حذف الورقة بنجاح أيضاً. ", vbInformation + vbMsgBoxRight + vbMsgBoxRtlReading Application.DisplayAlerts = True End Sub