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

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

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

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

جربت من عندي لامشكلة احتمال في اشكاليه في ملفك الاصلي لمدى البحث او ماشابه عموما حسب ضني استبدل هذا الكود بالموجود في ملفك الاصلي Public Sub Fltr() Dim Sh As Worksheet With My_Rnge Set Sh = Sheets("Sheet1") For Each R In Sh.Range("a4:a" & Split(Sh.UsedRange.Address, "$")(4)) If R <> "" Then If My_Rnge Is Nothing Then Set My_Rnge = R Else Set My_Rnge = Union(My_Rnge, R) End If End If Next End With Filtr_My "" End Sub

السلام عليكم السادة أعضاء الجروب الكرم لدي نموذج رئيسي وبه نموذج فرعي لأوامر التوريد وبه قائمة منسدلة لإظهار تفاصيل رقم أمر التوريد في النموذج الفرعي بعد التحديث لا تعمل ولا أعرف أين المشكلة وشكراً تجربة اوامر التوريد والصرف.rar

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

أستاذنا jjafferr أعتقد أن أ.eslamali2 يسأل عن كود لعمل هوامش التقرير بالسنتيمتر وليس بالبوصه وان كان كذلك فبعد إذنكم فليجرب الكود التالى Private Sub Report_Open(Cancel As Integer) Const TW As Integer = 567 Dim prt As Printer Dim rpt As Report Set rpt = Reports("اسم التقرير") Set prt = rpt.Printer With prt .LeftMargin = 1 * TW .RightMargin = 1 * TW .TopMargin = 1 * TW .BottomMargin = 1 * TW End With Set rpt = Nothing End Sub

بعد اذن الاساتذة ربما هذا الكود يفي بالغرض تقسيم مبلغ الدفع حسب الشرط.xlsm

الظاهر اني فهمتك خطأ !! لوسمحت تنسخ هذه المعادلات وتضعها في الاستعلام ، بدلا عن اللي موجودة حاليا: دائن: IIf([المبلغ]>0,[المبلغ],0) مدين: IIf([المبلغ]<0,[المبلغ],0) جعفر

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

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

وعليكم السلام 🙂 حسب فهمي للموضوع ، هناك طريقتين: 1. تضيف كلمة true في معيار الحقلين : . او 2. . جعفر

اللهم امين........ ان لله وان اليه راجعون البقاء والدوام الله وحده , اللهم ارحمه وأحسن نزله وصبر اللهم أهله وزويه والهمهم الصبر والسلوان

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

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

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

السلام عليكم اخي يمكنك الاستفادة من المثال المرفق وفيه طلبك على ما اضن مثال.rar

وتيسيرا على احبابى الاستاذ @محمد صلاح1 و الاستاذ @عبد اللطيف سلوم هذا مثال عملى getMacAddress.mdb

السلام عليكم احبائى واساتذتى الأعزاء,أتمنى ان تكونوا جميعا في أحسن حال أرجو التكرم من سيادتكم على مساعدتى في عمل اختصار لكود ترحيل البيانات من الفاتورة الى الصفحة الأخرى فالكود طويل جدا فياريت أجد عن حضراتكم حل لإختصار وتقصير هذا الكود بحيث يقوم بنفس المهام وهذا هو الكود : Private Sub FillSalesList() With Sheets("Sales").Columns(1).Rows(65536).End(xlUp) .Offset(1, 0) = Sheet1.[C1] .Offset(1, 1) = Sheet1.[C3] .Offset(1, 2) = Sheet1.[C5] .Offset(1, 3) = Sheet1.[C7] .Offset(1, 4) = Sheet1.[C9] .Offset(1, 5) = Sheet1.[A12] .Offset(1, 6) = Sheet1.[B12] .Offset(1, 7) = Sheet1.[C12] .Offset(1, 8) = Sheet1.[D12] .Offset(1, 9) = Sheet1.[E35] .Offset(1, 10) = Sheet1.[E36] .Offset(1, 11) = Sheet1.[E37] .Offset(1, 12) = Sheet1.[E38] If Sheet1.[a13].Value <> "" Then .Offset(2, 0) = Sheet1.[C1] .Offset(2, 1) = Sheet1.[C3] .Offset(2, 2) = Sheet1.[C5] .Offset(2, 3) = Sheet1.[C7] .Offset(2, 4) = Sheet1.[C9] .Offset(2, 5) = Sheet1.[a13] .Offset(2, 6) = Sheet1.[B13] .Offset(2, 7) = Sheet1.[C13] .Offset(2, 8) = Sheet1.[D13] End If If Sheet1.[a14].Value <> "" Then .Offset(3, 0) = Sheet1.[C1] .Offset(3, 1) = Sheet1.[C3] .Offset(3, 2) = Sheet1.[C5] .Offset(3, 3) = Sheet1.[C7] .Offset(3, 4) = Sheet1.[C9] .Offset(3, 5) = Sheet1.[a14] .Offset(3, 6) = Sheet1.[B14] .Offset(3, 7) = Sheet1.[C14] .Offset(3, 8) = Sheet1.[D14] End If If Sheet1.[a15].Value <> "" Then .Offset(4, 0) = Sheet1.[C1] .Offset(4, 1) = Sheet1.[C3] .Offset(4, 2) = Sheet1.[C5] .Offset(4, 3) = Sheet1.[C7] .Offset(4, 4) = Sheet1.[C9] .Offset(4, 5) = Sheet1.[a15] .Offset(4, 6) = Sheet1.[B15] .Offset(4, 7) = Sheet1.[C15] .Offset(4, 8) = Sheet1.[D15] End If If Sheet1.[a16].Value <> "" Then .Offset(5, 0) = Sheet1.[C1] .Offset(5, 1) = Sheet1.[C3] .Offset(5, 2) = Sheet1.[C5] .Offset(5, 3) = Sheet1.[C7] .Offset(5, 4) = Sheet1.[C9] .Offset(5, 5) = Sheet1.[a16] .Offset(5, 6) = Sheet1.[B16] .Offset(5, 7) = Sheet1.[C16] .Offset(5, 8) = Sheet1.[D16] End If If Sheet1.[a17].Value <> "" Then .Offset(6, 0) = Sheet1.[C1] .Offset(6, 1) = Sheet1.[C3] .Offset(6, 2) = Sheet1.[C5] .Offset(6, 3) = Sheet1.[C7] .Offset(6, 4) = Sheet1.[C9] .Offset(6, 5) = Sheet1.[a17] .Offset(6, 6) = Sheet1.[B17] .Offset(6, 7) = Sheet1.[C17] .Offset(6, 8) = Sheet1.[D17] End If If Sheet1.[a18].Value <> "" Then .Offset(7, 0) = Sheet1.[C1] .Offset(7, 1) = Sheet1.[C3] .Offset(7, 2) = Sheet1.[C5] .Offset(7, 3) = Sheet1.[C7] .Offset(7, 4) = Sheet1.[C9] .Offset(7, 5) = Sheet1.[a18] .Offset(7, 6) = Sheet1.[B18] .Offset(7, 7) = Sheet1.[C18] .Offset(7, 8) = Sheet1.[D18] End If If Sheet1.[a19].Value <> "" Then .Offset(8, 0) = Sheet1.[C1] .Offset(8, 1) = Sheet1.[C3] .Offset(8, 2) = Sheet1.[C5] .Offset(8, 3) = Sheet1.[C7] .Offset(8, 4) = Sheet1.[C9] .Offset(8, 5) = Sheet1.[a19] .Offset(8, 6) = Sheet1.[B19] .Offset(8, 7) = Sheet1.[C19] .Offset(8, 8) = Sheet1.[D19] End If If Sheet1.[a20].Value <> "" Then .Offset(9, 0) = Sheet1.[C1] .Offset(9, 1) = Sheet1.[C3] .Offset(9, 2) = Sheet1.[C5] .Offset(9, 3) = Sheet1.[C7] .Offset(9, 4) = Sheet1.[C9] .Offset(9, 5) = Sheet1.[a20] .Offset(9, 6) = Sheet1.[B20] .Offset(9, 7) = Sheet1.[C20] .Offset(9, 8) = Sheet1.[D20] End If If Sheet1.[a21].Value <> "" Then .Offset(10, 0) = Sheet1.[C1] .Offset(10, 1) = Sheet1.[C3] .Offset(10, 2) = Sheet1.[C5] .Offset(10, 3) = Sheet1.[C7] .Offset(10, 4) = Sheet1.[C9] .Offset(10, 5) = Sheet1.[a21] .Offset(10, 6) = Sheet1.[B21] .Offset(10, 7) = Sheet1.[C21] .Offset(10, 8) = Sheet1.[D21] End If If Sheet1.[a22].Value <> "" Then .Offset(11, 0) = Sheet1.[C1] .Offset(11, 1) = Sheet1.[C3] .Offset(11, 2) = Sheet1.[C5] .Offset(11, 3) = Sheet1.[C7] .Offset(11, 4) = Sheet1.[C9] .Offset(11, 5) = Sheet1.[a22] .Offset(11, 6) = Sheet1.[B22] .Offset(11, 7) = Sheet1.[C22] .Offset(11, 8) = Sheet1.[D22] End If If Sheet1.[a23].Value <> "" Then .Offset(12, 0) = Sheet1.[C1] .Offset(12, 1) = Sheet1.[C3] .Offset(12, 2) = Sheet1.[C5] .Offset(12, 3) = Sheet1.[C7] .Offset(12, 4) = Sheet1.[C9] .Offset(12, 5) = Sheet1.[a23] .Offset(12, 6) = Sheet1.[B23] .Offset(12, 7) = Sheet1.[C23] .Offset(12, 8) = Sheet1.[D23] End If If Sheet1.[a24].Value <> "" Then .Offset(13, 0) = Sheet1.[C1] .Offset(13, 1) = Sheet1.[C3] .Offset(13, 2) = Sheet1.[C5] .Offset(13, 3) = Sheet1.[C7] .Offset(13, 4) = Sheet1.[C9] .Offset(13, 5) = Sheet1.[a24] .Offset(13, 6) = Sheet1.[B24] .Offset(13, 7) = Sheet1.[C24] .Offset(13, 8) = Sheet1.[D24] End If If Sheet1.[a25].Value <> "" Then .Offset(14, 0) = Sheet1.[C1] .Offset(14, 1) = Sheet1.[C3] .Offset(14, 2) = Sheet1.[C5] .Offset(14, 3) = Sheet1.[C7] .Offset(14, 4) = Sheet1.[C9] .Offset(14, 5) = Sheet1.[a25] .Offset(14, 6) = Sheet1.[B25] .Offset(14, 7) = Sheet1.[C25] .Offset(14, 8) = Sheet1.[D25] End If If Sheet1.[a26].Value <> "" Then .Offset(15, 0) = Sheet1.[C1] .Offset(15, 1) = Sheet1.[C3] .Offset(15, 2) = Sheet1.[C5] .Offset(15, 3) = Sheet1.[C7] .Offset(15, 4) = Sheet1.[C9] .Offset(15, 5) = Sheet1.[a26] .Offset(15, 6) = Sheet1.[B26] .Offset(15, 7) = Sheet1.[C26] .Offset(15, 8) = Sheet1.[D26] End If If Sheet1.[a27].Value <> "" Then .Offset(16, 0) = Sheet1.[C1] .Offset(16, 1) = Sheet1.[C3] .Offset(16, 2) = Sheet1.[C5] .Offset(16, 3) = Sheet1.[C7] .Offset(16, 4) = Sheet1.[C9] .Offset(16, 5) = Sheet1.[a27] .Offset(16, 6) = Sheet1.[B27] .Offset(16, 7) = Sheet1.[C27] .Offset(16, 8) = Sheet1.[D27] End If If Sheet1.[a28].Value <> "" Then .Offset(17, 0) = Sheet1.[C1] .Offset(17, 1) = Sheet1.[C3] .Offset(17, 2) = Sheet1.[C5] .Offset(17, 3) = Sheet1.[C7] .Offset(17, 4) = Sheet1.[C9] .Offset(17, 5) = Sheet1.[a28] .Offset(17, 6) = Sheet1.[B28] .Offset(17, 7) = Sheet1.[C28] .Offset(17, 8) = Sheet1.[D28] End If If Sheet1.[a29].Value <> "" Then .Offset(18, 0) = Sheet1.[C1] .Offset(18, 1) = Sheet1.[C3] .Offset(18, 2) = Sheet1.[C5] .Offset(18, 3) = Sheet1.[C7] .Offset(18, 4) = Sheet1.[C9] .Offset(18, 5) = Sheet1.[a29] .Offset(18, 6) = Sheet1.[B29] .Offset(18, 7) = Sheet1.[C29] .Offset(18, 8) = Sheet1.[D29] End If If Sheet1.[a30].Value <> "" Then .Offset(19, 0) = Sheet1.[C1] .Offset(19, 1) = Sheet1.[C3] .Offset(19, 2) = Sheet1.[C5] .Offset(19, 3) = Sheet1.[C7] .Offset(19, 4) = Sheet1.[C9] .Offset(19, 5) = Sheet1.[a30] .Offset(19, 6) = Sheet1.[B30] .Offset(19, 7) = Sheet1.[C30] .Offset(19, 8) = Sheet1.[D30] End If If Sheet1.[a31].Value <> "" Then .Offset(20, 0) = Sheet1.[C1] .Offset(20, 1) = Sheet1.[C3] .Offset(20, 2) = Sheet1.[C5] .Offset(20, 3) = Sheet1.[C7] .Offset(20, 4) = Sheet1.[C9] .Offset(20, 5) = Sheet1.[a31] .Offset(20, 6) = Sheet1.[B31] .Offset(20, 7) = Sheet1.[C31] .Offset(20, 8) = Sheet1.[D31] End If If Sheet1.[a32].Value <> "" Then .Offset(21, 0) = Sheet1.[C1] .Offset(21, 1) = Sheet1.[C3] .Offset(21, 2) = Sheet1.[C5] .Offset(21, 3) = Sheet1.[C7] .Offset(21, 4) = Sheet1.[C9] .Offset(21, 5) = Sheet1.[a32] .Offset(21, 6) = Sheet1.[B32] .Offset(21, 7) = Sheet1.[C32] .Offset(21, 8) = Sheet1.[D32] End If ' .Offset(1, 6) = Sheet1.[G1].Text End With End Sub وهذا هو الملف كود ترحيل الفاتورة.xlsm

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

يمكنك الإستعانة بهذا الرابط https://www.ablebits.com/office-addins-blog/2014/03/06/transpose-excel-rows-columns/

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

تفضل Book1.xlsx

دائما وابدا يجب رفع ملف للعمل عليه تجنبا لإهدار الوقت بارك الله فيك

الأستاذ /ياسين ( أبو سام ) السلام عليكم ورحمة الله وبركاته جزاك الله خيراً على مرورك الكريم وكلماتك الطيبة . تقبل الله منا ومنك صالح الأعمال.

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

سيدتي الفاضلة الغالية/ ام عبدالله اشكر تشريفك موضوعي ولاكني ساعقب علي ملفك 1)) استطيع صنع الدالة التي تحصي الراسب في العود E بسهولة فلي عامان اعمل علي الاكسيل وتعلمت الكثير القليل بالنسبة لعلمك الكبيروخاصة بمساعدة اخي محمد ابو البراء فكلاكما له الفضل في ملفي 2)) لقد وضعت الراسب لكي احددهما لنفسي كتيست وليعلم من يطلع علي الملف من هم الراسبين وشروط الرسوب 3)) وهو كالاتي اقل من 6 في الترم الثاني واقل من 30 في المجموع مع احتمالية تحقق الشرطين معا ووجود شرط الغياب في الترم الثاني فهذا العمود يعني اني انا الذي ساحدد الراسب لكل طالب ولاكن ما بالكي لو كان عدد الطلاب 1000 طالب فاين اوتوماتيكية العمل وفعل الدوال لقد ارفقت في الموضوع شيت مصغر لعدد 5 طلاب ومادة واحدة وانا ساطبق الدالة الصحيحة علي باقي المواد وعلي اي عدد من الطلاب

السلام عليكم الاخ الفاضل الجزيره هذا الكود في حدث 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