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

السلام عليكم 🙂 . جعفر

كل عام وجميع الاخوة بالمنتدى بالف خير من الجميل ان نبدأ العام بتهنئة بكود اكسس تحياتي للجميع test.rar

السلام عليكم 🙂 هناك الكثير من الميزات/الاوامر التي يعطينا برنامج الاكسس ، والتي يمكن ان نعمل لها بديل ، ولكن يكون هناك فرق في سرعة تنفيذ كودنا مقارنة مع الكود الاصل من الاكسس !! مثل القائمة المختصرة التي تظهر لنا بالنقر على زر الفأرة الايمن ، والتي بها يمكننا ان نستغني عن الكثير الاوامر ، مثل الفرز والتصفية بأنواعه ، ولكن وللأسف الشديد ، فأنا ارى ان 99.99% من البرامج ، يتم حذف هذه القائمة وعدم تفعيلها ، والسبب ان المستخدم يستطيع ان يدخل في تصميم النموذج من خلال هذه الاوامر(في الدائرة الحمراء) : و . ويضطر المبرمج ان يعوض بقية الاوامر في القائمة ، بمجموعة من الازرار ، او بطرق مختلفة !! ----------------------------------------------------------------------------------------------- الاكسس يسمح لنا ان نعمل قوائم مختصرة Shortcut Menu والتابعة لمجموعة CommandBars ، حسب احتياجنا ، ونختار ما نضعه فيها 🙂 هناك 3 انواع من هذه القوائم : الثابته ، والمؤقته ، والمؤقته التي تحتاج الى كود. الثابته: وهي التي عندما نعملها ، تصبح مستقله عن الكود ، وتُحفظ وتبقى في قاعدة البيانات بعد إغلاقها ، ويمكننا ان نستوردها في قاعدة بيانات اخرى عندما نستورد احد/جميع كائنات قاعدة البيانات الآخرى ، بإستخدام : . ونختارها في النموذج : . او التقرير : . هذا مثال لعمل الكود الاساس لعمل قائمة قطع/نسخ/لصق : Option Compare Database Option Explicit Dim cmb As Object Dim cmbCtrl As Object Dim cmbName As String ' ' ' to use: ' Dim cbr As Commandbar ' Dim cbrButton as CommandbarControl ' ' we have to select in the References: ' Microsoft Office xx.x Object Library ' Public Function SCM_Copy(Optional DeleteMe As Boolean = False) On Error Resume Next 'If menu with same name exists delete cmbName = "cmb_Copy" CommandBars(cmbName).Delete If DeleteMe = True Then Exit Function If Err.Number <> 0 Then Err.Clear Set cmb = CommandBars.Add(cmbName, msoBarPopup, False, False) With cmb .Controls.Add msoControlButton, 21, , , False ' Cut .Controls.Add msoControlButton, 19, , , False ' Copy .Controls.Add msoControlButton, 22, , , False ' Paste End With Set cmb = Nothing End Function . وشرح الكود : 1. اسم القائمة المختصرة ، والتي سوف نختارها في النموذج او التقرير ، 2. هذه المجموعة الاساس منبثقة Popup ، 3. بينما هذه المجموعات عبارة عن ازرار Buttons ، وقد تكون قائمة منسدلة Combobox ، او نص Edit نُدخل فيه قيمة معينة للتصفية مثلا ، 4. هل هذه القائمة مؤقته ؟ False معناها ثابته وتُحفظ في قاعدة البيانات ، بينما True معناها انها مؤقته وتعمل لما ننادي الوحدة النمطية/الكود ، 5. هذه ارقام كل امر ، وملف الاكسل المرفق من مايكروسوفت فيه جدول يضم جميع ارقام الاوامر للاكسس 2010 () ، 6. اذا اردنا ان نحذف هذه القائمة ، فننادي الوحدة النمطية بضم True في امر المناداة المؤقته: ونستعمل True في مكان الرقم 4 اعلاه. وهي التي عندما نعملها ، لا تصبح مستقله عن الكود ، ولا تبقى في قاعدة البيانات بعد إغلاقها ، ولا يمكننا ان نستوردها في قاعدة بيانات اخرى عندما نستورد احد/جميع كائنات قاعدة البيانات الآخرى (كما هو الحال مع القائمة الثابته) ، ويجب ان نستخدم "حدث فتح" النموذج/التقرير لعملها واستخدامها في النموذج/التقرير ، و "حدث اغلاق" النموذج/التقرير لحذفها ، طيب ، خلونا نعمل هذه القائمة : Public Function SCM_Copy_Sort(Optional DeleteMe As Boolean = False) On Error Resume Next 'If menu with same name exists delete cmbName = "cmb_Copy_Sort" CommandBars(cmbName).Delete If Err.Number <> 0 Then Err.Clear Set cmb = CommandBars.Add(cmbName, msoBarPopup, False, False) With cmb Set cmbCtrl = .Controls.Add(msoControlButton, 21, , , False) ' Cut cmbCtrl.Caption = "Cut..." cmbCtrl.FaceId = 21 Set cmbCtrl = .Controls.Add(msoControlButton, 19, , , False) ' Copy cmbCtrl.Caption = "Copy..." cmbCtrl.FaceId = 19 Set cmbCtrl = .Controls.Add(msoControlButton, 22, , , False) ' Paste cmbCtrl.Caption = "Paste..." cmbCtrl.FaceId = 22 Set cmbCtrl = .Controls.Add(msoControlButton, 210, , , False) 'Sort Ascending cmbCtrl.BeginGroup = True cmbCtrl.Caption = "فرز تصاعدي..." cmbCtrl.FaceId = 210 Set cmbCtrl = .Controls.Add(msoControlButton, 211, , , False) 'Sort Decending cmbCtrl.Caption = "فرز تنازلي..." cmbCtrl.FaceId = 211 End With Set cmb = Nothing End Function . وشرح الكود: احنا توسعنا في الكود الاساسي ، واضفنا له : 1. تسمية اختيارية غير الافتراضية ، لاحظ في الصورة اعلاه اني استعملت الانجليزي والعربي ، 3. وهو لعمل خط فاصل في الصورة بين مجموعة قطع/نسخ/لصق ومجموعة فرز تصاعدي/تنازلي ، . 2. ممكن ان نبدل الصورة الافتراضية التي تيجي مع الرقم ، بتبديل هذا الرقم (لاحظ صورة الاسهم للتصاعدي/التنازلي) : . ومرفق ارقام جميع الصور الموجودة في الاكسس : . . . . . . . . . . . في قاعدة البيانات المرفقة myRight_Click.mdb ، بالاضافة الى القوائم الثابته اعلاه ، تم اضافة هذه القائمة ايضا : . والتقرير يحتوي على القائمة المؤقته التالية : . - ملف الاكسل myList.xlsx ، اخترت فيه اهم القوائم في وجهة نظري ، - ملف الاكسل AccessControls_2010.xlsx ، من مايكروسوفت ، يحتوي على جميع الاوامر 🙂 جعفر المصادر: http://dev-soln.com/access-shortcut-right-click-tool/ https://www.experts-exchange.com/articles/12904/Understanding-and-using-CommandBars-Part-II-Creating-your-own.html https://filedb.experts-exchange.com/incoming/2014/02_w06/833359/CommandBars-II.mdb https://www.experts-exchange.com/articles/18341/CommandBars-Part-III-Using-Built-in-Shortcut-Menus.html http://www.skrol29.com/us/vtools.php AccessControls_2010.xlsx myList.xlsx myRight_Click.zip

وعليكم السلام-لك ما طلبت موازنة علي البنود لكل مشروع.xlsx

تفضل يا سيدي بعد اذن الاستاذ حسين طبعاً و بدون الاكواد ومشاكلها (الاكسل يمنع كذلك ادخال اي شي غير الارقام في النطاق من A1 الى A5 )) VERIFICATION.xlsx

تفضل >>>>>>> __برنامج المراجعة النهائية - نسخة.rar

اللهم قد أقبل علينا عام جديد نسألك الخير كله عاجله وأجله ونعوذ بك من شره كله عاجله وأجله، ونسألك اللهم عملا يقربنى إليك يا ذا الجلال والإكرام وصل الله على سيدنا محمد وعلى آله وصحبه وسلم

السلام عليكم تم التعديل على أمر البحث في كود اليوزرفورم (حسب ما أعرف)، وذلك بتغيير الأمر: Me.TextBox4.Value = Application.WorksheetFunction.VLookup(Val(Me.TextFind.Value), ss, 2, False) بالأمر: Me.TextBox4.Value = Application.WorksheetFunction.VLookup(IIf(IsNumeric(Me.TextFind.Value), Val(Me.TextFind.Value), Me.TextFind.Value), ss, 2, False) المصنف3.xlsm

جرب هذا الماكرو (كان من الافضل عدم وجود خلايا مدمجة) تم تبديل اسم الصفحة الثانية الى اسم بالاجنبية MY_DATA Sub Copy_With_Merged_Cells() Const My_step = 26 Dim M As Worksheet, S As Worksheet Dim I%, Ls%, x%, t% Dim MX%, R% Set M = Sheets("MY_DATA") Set S = Sheets("Sheet1") MX = Application.Max(M.Range("A:A")) Ls = S.Cells(Rows.Count, 1).End(3).Row: Ls = Ls + 1 R = M.Range("A:A").Find(MX, LookAt:=1).Row For I = 12 To R Step My_step M.Range("B" & I).Resize(19) = "" Next For I = 1 To Ls Step 20 t = My_step * x + 12 S.Range("A" & I).Resize(20).Copy M.Range("B" & t) x = x + 1 Next M.Columns(2).AutoFit End Sub الملف مرفق Copy_For_Me.xlsm

بارك الله فيك أستاذنا الفاضل سليم ولكن بعد إذنك أقترح أن تكون المعالة =AND(ISNUMBER(A1);SUM($A$1:$A$5)<=20) حتى إذا تم تغيير الأرقام الأولى بعذ ذلك فيظل التحقق من الصحة يعمل أستاذ حسين مامون بارك الله فيك ولكن بعد إذنك من الأفضل أن يوضع الكود في حدث Worksheet_Change لأن في حدث Worksheet_SelectionChange ممكن يقبل أي رقم زائد ولا يعطي الرسالة إلا بعد تحديده VERIFICATION.xlsx

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

جرب التعديل المستخدم asd كلمة السر 123 login __ (1).xlsm

كل عام وانتم الى الله اقرب تحياتي

وعليكم السلام ورحمة الله وبركاته نعم اخي الكريم كلمة Set من الكلمات المحجوزة في access وهناك الكثير ايضاً محجوز مثل add , all , and ... الخ وعند استخدام هذه الكلمات كإسم حقل او اسم جدول يحدث تعارض في الاوامر كما حدث معك تماماً تحياتي

جرب الملف التالي Annual_Repport.xls

شكرا جزيلا ، هدية جميلة 🙂 جعفر

اللهم إنا نسألك خيرها و نعوذ بك من شرها

الاخوة اعضاء المنتدى العظيم بمناسبة تجديد المنتدى بثوبه الجديد نتعرف على موضوع الدوال بطريقة بسيطة تكملة لموضوع كيفية تصميم شيت بالاكسل الذى تم تنفيذه سابقا ارجو ان ينال رضاكم الدوال الدوال هى أوامر تقوم بتنفيذ مهام معينة وتتم كتابتها داخل الخلايا المختلفة لورقة العمل ويمكن تقسيم الدوال الى ست مجموعات كما يلى 1 الدوال العامة 2 الدوال المالية 3 الدوال الرياضية 4 الدوال الحرفية 5 الدوال الخاصة بالتاريخ والوقت 6 دوال قاعدة البيانات تعال معا نتعرف على كيفية البحث عن الدوال المختلفة الموجودة بالاكسل كيفية استخراج الدالة.rar

انشأ صفحة جديدة باسم Sans_Merge (حيث ستجد الاسماء دون دمج) و نفذ هذا الماكرو (لا يجوز ان تلغي الدمج في الصفحة الاولى حتى لا يتعطل الماكرو الاول) Sub Remove_merg() Dim Ls% Ls = Sheets("Sheet1").Cells(Rows.Count, 1).End(3).Row: Ls = Ls + 1 Sheets("Sheet1").Range("A1:A" & Ls).Copy Sheets("Sans_Merge").Range("a1") Sheets("Sans_Merge").Range("A1:A" & Ls).UnMerge Sheets("Sans_Merge").Range("A1:A" & Ls).SpecialCells(4).EntireRow.Delete End Sub الملف مرفق من جديد (النتيجة في الصفحة Sans_Merge) Copy_For_Me_new.xlsm

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

جزاك الله خيرا وزادك من فضله استاذ احمد بدره

اللهم يا محوِّل الأحوال حوِّل حالنا الى أحسن الأحوال بحولك وقوتك يا عزيز يا متعال .. وأسأل الله لى ولكم أن نكون فى عامنا الجديد أجد عملا وأكبر أملا وألم شملا وأسعد حالا وأريح بالا .. كل عام أنتم بخير

كل سنة وصحيفتك عند الله سبحانه وتعالى احسن عملاً وقلبك اكثر صفاءً ونقاءً ولسانك لهجٌ بذكر الله ووجوهكم تزداد اشراقاً بحب الله . كل عام وانتم بالف خير ونتمنى ان يكون هذا العام عام الخير والبركة على امة المصطفى (ص)

كل عام وانتم بألف خير سنة جديدة مليئة بالافراح والمسرات وصحة وسلامة ان شاء الله

اللهم صلي على محمد وآل محمد تحية طيبة مباركة بالافراح والخير على اعضاء المنتدى الكرام 🌹0🌹2🌹0🌹2🌹👉 انشاء الله يكون هذا العام الجديد خير وبركة وصحة وعافية على بلادي العراق وعلى جميع البلدان العربية بالخير والسلام يا رب 🤲

اللهم قد أقبل علينا عام جديد نسألك الخير كله عاجله وأجله ونعوذ بك من شره كله عاجله وأجله، ونسألك اللهم عملا يقربنى إليك يا ذا الجلال والإكرام وصل الله على سيدنا محمد وعلى آله وصحبه وسلم كل عام وانتم طيبين والى الله اقرب وتقبل الله منا ومنكم صالح الاعمال تحياتى لكم اخوانى

بعد إذن أستاذنا الفاضل سليم جرب المرفق التقرير السنوى.xls

شاهد الصورتين

استبدل هذا السطر image_path = Application.GetOpenFilename(FileFilter:="Tiff Files(*.tif;*.tiff),*.tif;*.tiff,JPEG Files (*.jpg;*.jpeg;*.jfif;*.jpe),*.jpg;*.jpeg;*.jfif;*.jpe,Bitmap Files(*.bmp),*.bmp", FilterIndex:=2, Title:="Select A File", MultiSelect:=False)

تم علاج المشكلة كنت بدأت العمل علي ذلك لأني توقعت سؤالك عن ذلك في المساء ان شاء الله شاهد المرفق !_example_32.rar

أخي محمد .. اكتشفت أين تكمن المشكلة .. وجدت أن المشكلة في عدم ظهور اسم المادة واسم الشعبة هو ( ارتفاع الصف الذي بعد الصف الأخير في الشيت الأول فقط من كل مادة ) . الصف طبعا مخفي عدلته وجعلت ارتفاعه ( 14.25 ) كما بقية الصفوف التي قبله .. وظهر اسم المادة والشعبة في جميع المواد التي استوردتها .. سواء كان الاستيراد فردي أو الكل . شكر الله لك وجزاك عني خيرا .. ( بقي حاجة تتعلق بالتقرير وهي : لا أريد أن يظهر لي جميع الطلاب في المادة وإنما أريد فقط ( إظهار الطلاب الذين درجتهم أقل من 50 درجة .. الطلاب الناجحون لا حاجة لي بهم . ) الهدف من هذا البرنامج هو : ( استخراج عدد الرسوب في كل مادة ) .. وأريد أن يكون التعديل على هذا المرفق ( لأني عدلت في التصميم وأضفت التقرير ) فضلا لا أمرا .. وفقك الله . ‏‏برنامج المراجعة النهائية - نسخة.rar

شاهد المرفق !_example_31.rar

بسم الله الرحمن الرحيم والصلاه والسلام على سيدنا محمد وآله وصحبه وسلم اخوانى واحبتى فى الله قد رأيت هذه الداله فى مثال قدمه اخى @خالد سيسكو واحببت مشاركتكم اياها لنتعلم سويا ونستفاد من تعليقات وتوضيحات اخواننا واساتذتنا جزاهم الله عنا كل خير شرح بسيط داله StrComp للمقارنه لها ثلاث برامتيرات 1 - النص الأول 2 - النص الثانى 3 - الاوبشين المراد StrComp ( string1, string2 [, compare ] ) compare = مقارنه 3 - الاوبشن يوجد له اربع قيم اختيارى هذا هو نوع المقارنة لأداء الخيارات الصحيحة هي: 1 - vbUseCompareOption { -1 } يستخدم الخيار مقارنة 2 - { 0 } vbBinaryCompare مقارنة ثنائية 3 - { 1 } vbTextCompare المقارنة النصية 4 - { 2 } vbDatabaseCompare مقارنة بناء على قاعدة البيانات الخاصة بك بالنسبه لقيمه النتيجه 0 تعنى النصوص متطابقه بالنسبه لقيمه النتيجه 1 تعنى ان النص الاول اكبر من النص الثانى بالنسبه لقيمه النتيجه -1 تعنى ان النص الثانى اكبر من النص الاول لا حظ النتيجه مختلفه بالرغم ان قيم النصين فى المره الاولى والثانيه متشابيهين ولكن اختلاف الاوبشين فالمقارنه قمت بالاستعانه بالبحث واليكم بعض الروابط https://support.office.com/ar-sa/article/الدالة-strcomp-a9a4531e-3b2a-4218-b139-f7442bc10b96?omkt=ar-SA&ui=ar-SA&rs=ar-SA&ad=SA https://bettersolutions.com/vba/strings-characters/option-compare.htm https://www.techonthenet.com/access/functions/string/strcomp.php وبشرح فيديو هو شرح ل PHP اتمنى ان اكون قد قدمت لكم معلومه مفيده واسال الله ان تنتفعوا بها وان قصرت فاعذرونى فاننى مبتدء واحاول جاهدا التعلم قدر الامكان المثال الاول واللذى استفدت منه هذه الداله لمقارنه الباسورد والمثال الثانى حاجه بسيطه لزوم الشرح وفى الاخير نسالكم الدعاء تقبلوا تحياتى وتمنياتى لكم جميعا بالتوفيق والنجاح طبتم واهتديتم اظهار كلمة المرور.rar StrCompText.mdb

أستاذ hbar أين الضغط على الإعجاب ؟!! 💙

شاهد المرفق !_Omar_3.rar

تفضل انظر المرفق <<<<<<<<< ولاحظ سحب البيانات من خلال البرنامج في جدول باسم نسخة ( طبعا انا نسختها حتى تشوف النتيجة ... لأن المشكلة من جهازك في عدم ظهور اسم الشعبة والمادة ) جرب المرفق لربما زالت تلم المشكله ,,,,, ‏‏Database.mdb

ماعندك مشكلة طيب....

افتح محرر الاكواد وانظر المكتبة الموجودة في الصورة هل هي مؤشر عليها صح ....

جرب الملف المرفق واعلمني بالنتيجة ....... ‏‏Database1 (3).rar بالنسبة لحقل الشعبة والمادة ( قم بتغيير اسم الملف عندك من ‏‏Database الى اي اسم اخر مثلا ‏‏Database1 )

أستاذ ابومهندالخضري أين الضغط على الإعجاب ؟! 💙

أستاذ ابومهندالخضري لا اعلم لماذا لا تقوم بالضغط على الإعجاب على الرغم ان كل الإجابات ممتازة ؟!!!! 💙

لا لزوم للحلقات التكراري في هذه الجالة يكفي هذا الكود البسيط Sub Fill_Empty() Range("B2:F6").SpecialCells(4) = "/" End Sub

هذا معناه ان البرنامج معمول على وندوز ليس عربي !! فما هي اللغة اللي كان عليها الكمبيوتر لما عملت البرنامج؟ هل هناك حروف اجنبية (مو انجليزية) في البرنامج ؟ اعمل التالي: اعمل بملف اكسس جديد ، 1. استورد جميع الكائنات من الملف القديم ، وشغل البرنامج ، اذا اشتغل بدون مشاكل ، فقد تم حل المشكلة 🙂 وإلا ، اعمل بملف اكسس جديد ، 2. استورد الجداول فقط من الملف القديم ، وشغل البرنامج ، اذا اشتغل بدون مشاكل: ثم استورد الاستعلامات فقط من الملف القديم (طبعا الجداول ستكون موجودة) ، وشغل البرنامج ، اذا اشتغل بدون مشاكل: ثم استورد نموذج واحد فقط من الملف القديم ، وشغل البرنامج ، اذا اشتغل بدون مشاكل: تابع في استيراد النماذج والتقارير ، واحدا واحد ، الى ان تعرف النموذج/التقرير اليي فيه المشكلة ، فيجب عليك ان تعيد صنعه مرة ثانية. جعفر

بارك الله فيك أستاذنا الفاضل المبدع أستاذ سليم بعد إذنك لإثراء الموضوع استخدمت هذه المعادلة =IF(COUNTIF($D2:$AH2;"ع")<=$C2;TRUE;FALSE) حتى إذا حدث نسيان تسجيل يوم عارضة لشخص يتم حساب كل العارضة المسجلة Dawam.xlsx

جرب هذا الماكرو اذا وجدت اي خلية اصغر من صفر يقوم الكود بتحديدها لاصلاحها Dim Rg As Range Dim cel As Range, first_ad$, Other_Ad$ Private Sub Worksheet_SelectionChange(ByVal Target As Range) Application.EnableEvents = False Range("B1:D20").Interior.ColorIndex = 6 If Not Intersect(Target, Range("B1:D20")) Is Nothing _ And Target.Count = 1 Then Set Rg = Range("B1:D20").Find("-", lookat:=2) If Not Rg Is Nothing Then first_ad = Rg.Address: Other_Ad = first_ad Do Rg.Interior.ColorIndex = 50 Set Rg = Range("B1:D20").FindNext(Rg) Other_Ad = Rg.Address If Other_Ad = first_ad Then Exit Do Loop End If Else For Each cel In Range("B1:D20") If cel < 0 Then cel.Interior.ColorIndex = 50 Next End If Application.EnableEvents = True End Sub الملف مرفق MY_code.xlsm

تفضل فقط يمكنك استخدام معادلة المصفوفة هذه =IF(ROWS($K$4:K4)<=SUMPRODUCT(--(COUNTIF($I$4:$I$140,$D$4:$D$150)<>1)),INDEX($D$4:$D$150,SMALL(IF(COUNTIF($I$4:$I$140,$D$4:$D$150)<>1,ROW($D$4:$D$150)-ROW($D$4)+1),ROWS($K$4:K4))),"") Etat de developpement de solde.xlsx

السلام عليكم تفضل اخي الفاضل test1.xlsx

بعض التحديثات على نموذج البحث Officna.rar