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

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

في حدث بعد التحديث للحقل المطلوب الكتابة بحروف كبيرة ضع الكود التالي [txt] = UCase([txt]) txt هو اسم الحقل اكتب بشكل عادي وسوف تتحول الحروف الى كبيرة

اتفضل اخى شوف التعديل قمت بتغير اسم النموذج الفرعى ما علينا من ده الاهم هو الاشاره للنموذج الفرعى frm.Controls وليس me.Controls لان كده بتشير للنموذج الرئيسى نفسه Private Sub ÃãÑ10_Click() On Error GoTo Err_ÃãÑ10_Click Dim Ctl As Control If Xx = 0 Then Me.ÃãÑ10.Caption = "ÚÏã Êãßíä ÇáÚäÇÕÑ ÇáÓÇÈÞÉ" For Each Ctl In frm.Controls If Ctl.Tag = "en" Then Ctl.Enabled = True End If Next Xx = 1 Else Me.ÃãÑ10.Caption = "Êãßíä ÇáÚäÇÕÑ ÇáÛíÑ ããßäÉ" For Each Ctl In frm.Controls If Ctl.Tag = "en" Then Ctl.Enabled = False End If Next Xx = 0 End If Exit_ÃãÑ10_Click: Exit Sub Err_ÃãÑ10_Click: MsgBox Err.Description Resume Exit_ÃãÑ10_Click End Sub تقبل تحياتى بالتوفيق XorEnable_up.mdb

السلام عليكم أستاذ جعفر موضوع في قمة الروعة ملاحظة صغيرة في الكود الموضوع بالأعلى : هناك بعض المتغيرات غير مصرح بها مع أنها موجودة في المرفق لكن من يريد تطبيق الكود بشكل مباشر من المشاركة سوف يظهر له خطأ. Public Const msoBarPopup = 5 Public Const msoControlButton = 1 Public Const msoControlEdit = 2 Public Const msoControlComboBox = 4 Public Const msoButtonUp = 0 Public Const msoButtonDown = -1 أخيرا لي الشرف العظيم أن أقوم بتثبيت هذا الموضوع

القيمة المضافة.xlsx

جرب الملف المرفق والذي عملته سابقا للرد على احد الاعضاء الكرام عند تسجيل المندوب تظهر رسالة ان الاسم مسجل مسبقا مع اختيار اعادة تسجيلة برقم جديد بامكانك التعديل عليه ليحقق طلبك بحث وتصفية.accdb

اتفضل شوف المثال التالى ان شاء الله يفيدك وجزاه الله خيرا استاذ محمد ندا كان فى مثال تانى عندى لام عهود بس مش لاقيه حاليا هدور عليه تانى تقبل تحياتى بالتوفيق _ترقيم غير تلقائى بنطاقات متعددة بنفس الجدول خمس شركات فى جدول واحدNumering_QuestionUP2.rar

مساهمة مع استاذنا واخي @خالد سيسكو في المرفق نموذج بسيط كنت قدم عملتة ردا على الدكتور الفاضل @حلبي لحساب العمر بالسنوات ادخل سنة الميلاد يحسب سنوات العمر او ادخل العمر يتم تحديد سنة الميلاد حساب العمر بالسنة(1).accdb

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

الموضوع ليس بالسهل او الهين فطلباتك صعبة ... ولا أعلم لماذا انت غضبان ؟!!! فلابد ان تلتمس دائما وابدا العذر للأساتذة فانت لا تعرف مدى انشغالهم وردهم هنا بالمنتدى لا اجر له فلهم اعمالهم الخاصة , انما مساعدة الأعضاء لوجه الله ليس هناك اجر فيه

جرب هذا الملف الكود يعمل في النطاق من A1 الى A10 (اللون الأصفر) الكود Option Explicit Private Sub Worksheet_SelectionChange(ByVal Target As Range) Application.EnableEvents = False If Not Intersect(Target, Range("A1:A10")) Is Nothing _ And Target.Count = 1 Then Range("B1:B10").ClearContents Target.Offset(, 1) = Range("F1") End If Application.EnableEvents = True End Sub الملف مرفق Writ in Offset.xlsm

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

تفضل سؤال وجواب1.xlsm

الحمد لله اخي احمد وفالك التوفيق ابو بسملة 🌷

وإياك أخي خالد .. ( لا تعلم أخي خالد ما الذي قدمه لي الأخ محمد .. فهو اختصر عليّ كثيرا من الجهد والوقت ) . أرى أنه واجب عليّ أن أدعو له ولكل من قدم خدمة للغير هو في أمسّ الحاجة إليها .. والشكر أيضا للقائمين على هذا المنتدى الرائع فهو والله مكسب ..

اخي الفاضل @emam1424 جزاك الله كل خير على دعائك الطيب لاخي العزيز محمد البرناوي والذي يستحق الدعاء والثناء الجميل على جهده يقول النبي ﷺ من لا يشكر الناس لا يشكر الله

اخي الفاضل @أحمد الفلاحجى ارفق لك نموذج مصغر لاحتساب الاجمالي للمشتريات الشهرية لكل مورد بنفس الطريقة التي وضعتها في الرد السابق امل الاطلاع لعل يكون فيه اجابة على استفساركم اخي العزيز Format(Nz(DSum(" [Total]";"Invoices_p";"month([Date of invoice])=" & [Expr1] & "And [customer]='" & [Customer] & "'");0);"عملة") لاحظ علامات التنصيص للحقل الرقمي وللحقل النصي format يمكن الاستغناء عنها ولكن انا استخدمتها للحصول على تنسيق عملة مباشرة Database74.accdb

السلام عليكم حل من الحلين التاليين: الحل1: إلغاء التصفية ثم إضافة ما تريد والمحافظة على الترتيب الأبجدي ثم إعادة التصفية... الحل2: مع التصفية، القيام بإدراج صف فارغ في المكان الصحيح بعد تحديد الصف الذي يأتي بعده بالترتيب الأبجدي (مثلا إضافة الاسم "عادل" القيام بتحديد الصف الذي فيه الاسم "علي") ثم القيام بحجز الاسم المضاف بمعلوماته... غير أن هذه الطريقة لا تضمن أن تترتب القائمة الكلية (ذكور وإناث) أبجديا بعد إلغاء التصفية... ولا أرى حلا آخر للمسألة... بن علية حاجي

الكود اللازم Sub add_names() Dim Ls% Ls = Sheets("Sheet1").Cells(Rows.Count, 1).End(3).Row: Ls = Ls + 1 Sheets("Sans_Merge").Range("K:K").Clear Sheets("Sheet1").Range("A1:A" & Ls).Copy Sheets("Sans_Merge").Range("K1") With Sheets("Sans_Merge").Range("K1:K" & Ls) .UnMerge .SpecialCells(4).Formula = "=k1" End With End Sub الملف من جديد Rxtra_Copy_For_Me.xlsm

جرب هذا الكود Option Explicit Sub give_data() Dim ARR_P, P As Worksheet, D As Worksheet Dim MY_RG As Range, MY_NAME$, R%, i% ARR_P = Array(4, 6, 9, 2, 16, 15, 17, 13, 14, 7, 8, 3, 18, 19) Set P = Sheets("Principal"): Set D = Sheets("DATA") P.Cells(7, "C").Resize(14) = vbNullString MY_NAME = P.Range("A3") Set MY_RG = D.Range("B3").CurrentRegion If MY_RG.Columns("E").Find(MY_NAME, lookat:=1) Is Nothing Then Exit Sub R = MY_RG.Columns("E").Find(MY_NAME, lookat:=1).Row For i = 0 To UBound(ARR_P) P.Cells(7, "C").Offset(i).Value = D.Cells(R, ARR_P(i)) Next Erase ARR_P End Sub الملف مرفق Data_base.xlsm

من بعد اذن استاذي احمد المحترم اخي ابو صلاح يوجد شرح وافي لدالة DMAX وتطبيق ايظاً من خلا الدرس ادناه للاخ الاستاذ عبد العاطي حمدان والدرس من جزئين انقله للفائدة مع الشكر

عند استخدام معيار الشهر للحصول على اجمالي المبيعات او المشتريات لشهر محدد وكان لدينا سجلات تتوافق مع رقم الشهر لسنوات ماضية فانه سوف تواجهنا مشكلة جمع المبيعات لكافة الاشهر التي تتوافق مع المعيار المحدد مثلا مبيعات شهر 1/2018 و1/2019 و 1/2020 وهكذا لذالك يتطلب منا اضافة لرقم الشهر ان نستخدم معيار السنة بجانب الشهر وممكن عمل ذلك بعدة طرق ومن اسهل الطرق وايسرها ان نعمل حقلين في الاستعلام الاول لرقم الشهر من تاريخ الفاتورة والاخر للسنة وايضا من تاريخ الفاتورة Month([Date of invoice]) لرقم الشهر Year([Date of invoice]) للسنة وللحصول على مبلغ المبيعات نستخدم دالة DSum Format(Nz(DSum(" [Total]";"Invoices";"year([Date of invoice])=" & [y] & "And Month([Date of invoice])=" & [m]);0);"عملة") ومرفق مثال بسيط تم عملة على عجالة وللتسهيل على المتلقي تم عمل فصل الاشهر والسنوات في استعلام والنتيجة النهائية في استعلام ثاني Database74.accdb

تقضل اخي الكريم عند إدخال تاريح الميلاد يحولها الي عمر (باليوم والشهر والسنة) في النموزج Database1.rar

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

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

السلام عليكم قم بإضافة هذا الكود للاستعلام ليقوم باختبار الشهر و السنة معا. Expr2: Format([Date de Contrat],"yyyy") Format(Date(),"yyyy")

ادراج وتشغيل صورة متحركة بملف الاكسل الفيديو

الحمد لله رب العالمين ... حياك اخي امام .... بالتوفيق ....

لاظهار رقم الشهر =Month(Date()) او =Format(Date();"m") ولاسم الشهر الحالي =Format(Date();"mmm")

شكرا جزيلا لك أستاذنا الفاضل جعفر إضافة جميلة في المنتدى ، و حاجتها واردة ومتكررة . وشرح وافي ومميز .

شكرا للاستاذ سليم وللقائمين على المنتدي

في المرفق Database178.mdb

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

جرب هذا الماكرو Option Explicit Sub divise_cells() Dim i%: i = 1 Dim dic As Object Dim itm, k, m%: m = 1 Range("c1").CurrentRegion.ClearContents Set dic = CreateObject("Scripting.Dictionary") Do Until Range("a" & i) = vbNullString dic(i) = Split(Range("a" & i), ",") i = i + 1 Loop For Each itm In dic.items Cells(m, 3).Resize(, UBound(itm) + 1) = itm m = m + 1 Next dic.RemoveAll: Set dic = Nothing End Sub Taksim.xlsm

الشكر لله اخى ولاساتذتنا الكرام جزاهم الله عنا خيرا الجزاء بالنسبه لطلبك على ما اعتقد مينفعش لان الكمبو بتحدد قيمه واحده ممكن تجرب المثال تقرير يعرض ما تم اختياره من Listbox تعرض فيه اسماء تقاريرك زى ما هتعرضها فالكمبو وتحدد اللى عاوز تطبعه وتطبعه ولعل احد اخواننا واساتذتنا يكون عنده حل للكمبو او افاده اكتر تقبل تحياتى

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

انا شخصياً تداركت هذا الخطأ و كنت في طريق اصلاحه لكن بما انك سبقتني اليه فجزاك الله خيراً

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

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

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

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

جرب تغيير الأرقام و ستلاحظ المطلوب Annual_Repport.xls

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

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

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

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

وعليكم السلام ورحمه الله وبركاته اتفضل اخى 3 امثله جزاها الله خيرا ام عهود تقبل تحياتى تقرير يعرض ما تم اختياره من Listbox فقط,up.rar عرض اكثر من تقرير للاختيار من بينهم التقرير المطلوب طبعهs.rar مشاهدة و طباعة التقارير من قائمة منسدلةort.rar

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

بص كده // ممكن // جربها وان شاء الله هتنفع انت ممكن تعمل تحديد لجميع مربعات النص المنضمه فى التقرير ـ وتعملهم كلهم قابل للنمو ـ وتعملهم جدولي وتقريبا تم ذكر الاجابة لكن مش بالتفصيل ــ /// لكن تقريبا اهم حاجه يكون فى خلية واحده او اكثر مربع النص الخاص بها عباره عن نص طويل ـ أو فى الاصدارات القديمة ان يكون نوع الحقل مذكرة

السلام عليكم هذا البرنامج قد كنت نزلته من النت ولا أذكر من أي موقع بالتحديد لبعد الوقت ولكن لا يتعدى موقعين الفريق العربي أو جامعة أهلا عرب في حوالي 1423هـ أي ما يوافق 2003 وكنت حينذاك بصدد إعداد برنامج مكتبة للأطفال وقد استفدت منه كثيرا جزى الله من قام عليه خير الجزاء . ولكني الآن فوجئت بالبرنامج نفسه باسم آخر غير صاحبه الأول والعجيب في الأمر أن البرنامج هو البرنامج لم يتغير فيه شيء حتى اسم قاعدة البيانات هي نفسها لم تتغبر main13 فقط تغير اسم صاحب البرنامج وإليك صورتين لتقارن بينهما وانتبه لتاريخ الإصدار .