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

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

فورم لحساب التكاليف للمنتج بالضريبة باستخدام الدالة VLOOKUP الفيديو

اختصار بسيط للكود الوارد سابقاً Option Explicit Sub test_1() Dim slash$: slash = "-" Dim x%, k%: k = 6 Range("G6:G" & Rows.Count).ClearContents Do Until Range("D" & k) = vbNullString x = InStrRev(Range("D" & k), slash) If x Then Range("G" & k) = Replace(Range("D" & k), " ", 1, x + 1) End If k = k + 1 Loop End Sub

اذا اردتها بواسطة الماكرو الكود Option Explicit Sub test() Dim slash$: slash = "-" Dim x%: x = 1 Dim k%: k = 6 Dim st Range("G6").CurrentRegion.ClearContents Do Until Range("D" & k) = vbNullString st = Range("D" & k) Do Until x = 0 x = InStr(st, slash) If x Then st = Replace(st, " ", 1, x + 1) Loop Range("G" & k) = st k = k + 1 x = 1 Loop End Sub

اخى ابو نصار الكود يعمل بكفاءه كعادة اكوادك اسال الله ان يجزيك كل خير ============================= اخى سليم اشكرك على مجهودك وردودك السريعة على الاعضاء تقبل منى تحياتى واحترامى اخى العزيز اشكر لك مجهودك

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

السلام عليكم وبالامكان الاستعانه بدالة معرفة كالتالي Function Ali_Splt(F, Optional S As String = " ") Dim x, c x = Split(Mid(F, 7, Len(F)), S) For i = LBound(x) To UBound(x) If i <= 1 Then c = c & S & x(i) Next i If Len(F) > 0 Then Ali_Splt = c End Function

السلام عليكم جرب المرفق هل هذا ماتريد 2009 2.xlsm

افلح وجهك يا غالي الخطأ من عندي انا الحمد لله تم الحل وجزاك الله خيرا اخي الحبيب تحياتي

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

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

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

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

بارك الله فيك وزادك الله من فضله ولك بمثل ما دعوت لى وزيادة والحمد لله الذى بنعمته تتم الصالحات

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

السلام عليكم تفضل جرب المرفق امل ان به ماتريد المخالفات1.xlsm

وعليكم السلام-لك ما طلبت ٢٢الخدمات الانتاجية 1كاملة.xlsx

وعليكم السلام ورحمة الله وبركاته تم عمل وحدة نمطية لاستدعاء رابط الصورة في أي مكان سواء كان نموذج او تقرير وفي حدث الحالي او التحميل او الفتح 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

عجبنى الموضوع ده قلت أشاركه معكم بإختصار هو سكريبت لعمل مكان موثوق لملفات الأكسيس من مكان تشغيله .. بمعنى لو شغلته من 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

Public Function getMacAddress(Optional strComputer As Variant) As String Dim oWMIService As Object Dim oMacs As Object Dim oMac As Object Dim strComp As Variant 'if no computer name is passed then use the name of the computer running the code. If IsMissing(strComputer) Then strComputer = "." End If Set oWMIService = GetObject("winmgmts:" & "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2") Set oMacs = oWMIService.ExecQuery("Select * from Win32_NetworkAdapterConfiguration") 'Win32_ComputerSystem For Each oMac In oMacs If IsNull(oMac.MacAddress) = False Then 'Debug.Print oMac.MacAddress getMacAddress = oMac.MacAddress End If Next End Function call getMacAddress MacAddress ان اردت القراءة اكثر عنها https://ar.wikipedia.org/wiki/عنوان_التحكم_بالنفاذ_للوسط الله يسلم حضرتك استاذى الجليل واخى الحبيب استاذ @Barna جزاكم الله خيرا

الملحوظة الأولي : تطبيق التلوين على المعادلات ايضا و ليس النصوص فقط ربما لا يمكن عمل ذلك ، و اتمني أن يجد الأخوة حل لهذا الأمر الملحوظة الثانية : تطبيق التلوين على ما يكتب من النصوص و ليس فقط عند تعديل الخلية 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

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

وعليكم السلام ضع هذا الكود فى حدث الصفحة 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

جرب هذا الملف لعله يفيدك وهناك ايضا رابط هنا قد ناقش هذه الجزئية يمكنك الإطلاع عليه https://www.officena.net/ib/topic/78197-ضريبة-كسب-العمل-الجديده-بالاكسيل/ أحتساب ضرائب الدخل بعد تحديث يوليو - 2018.xlsm

وعليكم السلام استاذ أحمد غانم وشاكر حضرتك على المرور العطر الذى شرفنى

بعد اذن الأستاذ شريف ولإثراء الموضوع هذه معادلة مجموع الكميات السالبة =-SUMIF($C$2:$C$9956,"<0") وهذه معادلة الكميات الموجبة =SUMIF($C$2:$C$9956,">0") بارك الله فيكم جميعا

بارك الله فيكم جميعا وشاكر على مروركم المشرف العطر

تفضل هذا كود حماية المدخلات بمعنى يمكنك الإدخال مرة واحدة فى الخلايا ولا يمكن ولا يمكن التعديل على المدخلات الأولى وهذا الكود يوضع فى حدث الورقة Option Explicit Dim Old_value Dim New_value Private Sub Worksheet_SelectionChange(ByVal Target As Range) Old_value = Target.Cells(1, 1).Value End Sub '============================================== Private Sub Worksheet_Change(ByVal Target As Range) Application.EnableEvents = False On Error GoTo Final_Step If Intersect(Target, Range("A1:XFD10000")) Is Nothing Then GoTo Final_Step New_value = Target.Value If Target.Cells.Count > 1 Then Application.Undo GoTo Final_Step End If If Old_value = "" And Target.Cells.Count > 1 Then Application.Undo GoTo Final_Step End If If Old_value = "" Then Target.Value = New_value Else Application.Undo End If Final_Step: Application.EnableEvents = True End Sub وهذا كود اخر لحماية الخلايا بعد المدخلات مباشرة بكلمة سر ويوضع ايضا فى حدث الصفحة -وكلمة السر هى 123 Private Sub Worksheet_Change(ByVal Target As Range) Dim xRg As Range On Error Resume Next Set xRg = Intersect(Range("A1:XFD10000"), Target) If xRg Is Nothing Then Exit Sub Target.Worksheet.Unprotect Password:="123" xRg.Locked = True Target.Worksheet.Protect Password:="123" End Sub

سيدتي الفاضلة / ام عبدالله طولي بالك عليا شوية معلش وبدون ان يكون هناك اثقال اولا انا احب افهم واحب امشي بسيستيم واحد بصي دالة حساب الناجح اللي هي =SUMPRODUCT((D8:D13>=30)*(C8:C13>=6)*(C8:C13<>"غ")) تمام عكستها بالشكل التالي لاخراج الراسب =SUMPRODUCT((D8:D13<30)*(C8:C13<6)*(C8:C13="غ")) كان المفروض يديني عدد الراسب 5 محصلشي لاكن طريقة اني احسب الناجح بطريقة والراسب بطريقة مش متقبلها ثانيا : انا بس عايز حضرتك تبصي علي المعادلة اللي في الخلية G14 ليه مطلعة الناتج 2 في حين انه طبقا للبيانات مفروض ميطلعشي غير واحد