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

السلام عليكم اقدم لكم نسخه من برنامج كاشير للمطاعم حسب ارقام الطاولات رقم المظلل بالاحمر يعني ان الطاولة رقم ... محجوز يمكنك رجوع اليها وعمل اوردر من تعديل البرنامج سهل للغايه يعمل فقط على الماوس * - الجدول : _ الفواتير المسدده يمكنك رجوع وتعديل عليها عن طريق الجدول وضغط دبل كليك على المراد تعديله * - التقرير :_ *- حذف الفواتير :_ يمكنك حذف الفواتير عن طريق تحديد الرقم وضغط على حذف يمكن استعلام على الفواتير المحذوفه من التقرير - فواتير محذوفه *- نقل الطاولة :_ يمكن نقل الطاولة حسب طلبك بتحديد على الطاولة المراد نقلها واختيار امر نقل الطاولة يظهر مربع تختار رقم الطاولة الجديد بحيث لا يكون مظلل بالاحمر . *- تعديل على الفاتورة : _ في حال رغبت الزبون طلب اوردر تختار رقم الطاولة المظلل بالاحمر وتغضط تعديل الفاتورة وتضيف الاوردر الثاني ويمكنك تكرار العملية في حال تكرار الصنف تضغط دبل كليك على الصنف +1 في حال الغاء -1 يوجد زر بجانب الشاشة الاصناف -1 في حال الغاء الصنف يوجد زر بجانب الشاشة * * - الاصناف : _ يمكنك اضافة اصناف رئيسية واصناف فرعيه الاصناف لا تحتاج الى كود لانها تختار كود اتوماتيكي طباعه الفواتير بشكل جديد دينماكيه صلاحية كامله للبرنامج الدخول : الدعم الفني كلمة سر : 123 يمكنك اضافت صلاحيات ومستخدمين كما قلت لكم نسخه قيد تطوير ... الحقوق النشر محفوظه ... اتنمنى ان ينال اعجابكم لتحميل : _ ‫كاشير-توزيع.xlsb

تفضل لأنك لم تطبق المعادلة بطريقة صحيحة تقاطع العمود مع السطر OK.xlsx

أحسنت استاذ سليم كود ممتاز جعله الله فى ميزان حسناتك

حبيبي أبا بسملة بل الشكر لك علي حسن متابعتك من فضلك قم بازالة علامة التعجب من الكود وضع بدلا منها النقطة ليصبح الكود هكذا If Me.PrintBillCount = 0 Then Me.Picture = CurrentProject.Path & "\Original.jpg" Else Me.Picture = CurrentProject.Path & "\Copy.jpg" End If وعند وضع النقطة تأكد من أن كلمة Picture موجودة بالفعل في خيارات الاكمال التلقائي في محرر الأكواد في 2003 ثم قم بعمل compile مرة أخري وتأكد من وجود الصورتين فى نفس مسار قاعدة البيانات ووافنا بالنتائج

تفضل ملفك بعد التعديل .... تجربة برنامج خطابات متعددة.rar

يمكنك استخدام هذا الكود فسوف يتم عمل ملف منفصل برقم الفاتورة عند الضغط على ترحيل فبذلك يمكنك طباعة اى فاتورة تريدها Sub Splitbook() Dim xPath As String ActiveSheet.Name = ActiveSheet.Range("AP2") & " NO" & Range("E6") xPath = Application.ActiveWorkbook.Path Application.ScreenUpdating = False Application.DisplayAlerts = False For Each xWs In ThisWorkbook.Sheets xWs.Copy Application.ActiveWorkbook.SaveAs Filename:=xPath & "\" & xWs.Name & ".xlsx" Application.ActiveWorkbook.Close False Next Application.DisplayAlerts = True Application.ScreenUpdating = True Range("E6") = ([E6]) + 1 End Sub Invoice.xlsm

أحسنت استاذ أنس عمل رائع جعله الله فى ميزان حسناتك وبالتوفيق ان شاء الله

بارك الله فيك

وعليكم السلام-دائما وابداً باتأكيد لابد من رفع الملف لإستجابة الأعضاء والأساتذة فى مساعدتك تفضل يمكنك استخدام هذه المعادلة =IF(A13<20,25,IF(AND(A13>=20,A13<=30),25+(A13-20)*1.5,IF(AND(A13>30,A13<=40),25+(9*1.5)+(A13-31)*2,IF(A13>40,25+(9*1.5)+(9*2)+(A13-41)*2.5,"")))) مثال توضيحي1.xlsx

اهلا بك فى المنتدى-تفضل DG Inv Empty.xlsm

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

تفضل لك ما طلبت Split & Search.xlsx

استاذ ابو صلاح معادلة الأستاذ سليم تعمل بكل كفاءة ,فهى لا تحتاج اى تعديل -فاذا اعطت لك خطأ فمنك انت:-وذلك لأحد سببين, فهذه معادلة مصفوفة لابد من الضغط على Ctrl+Shift+Enter وليس Enter فقط كما اخبرك استاذنا سليم و الأخر اذا مازالت لا تعمل معك فعليك باستبدال الفاصلة العادية بفاصلة منقوطة ; فربما نظام الكمبيوتر لديك مختلف

وعليكم السلام -تفضل ~$زيادة او نقصان سنة في عدة صفوف عن طريق زر.xlsm

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

الكثير منا يلجأ لاستخدام التبويب في النماذج ولكن مشكلة هذه التبويبات كلها تكون بنفس لون الخلفية فإليكم الفكرة التالية منقول من احد المواقع الاجنبية ( تم تعريب بواسطتي ) انظر المرفقات Colored Tabs.rar

هل هذا المطلوب مقارنة واحتساب الفرق عند تساوي رقم الايصال مثال.accdb

جرب هذا الكود Option Explicit Sub get_data() Application.ScreenUpdating = False Dim S As Worksheet Dim Cus As Worksheet Dim m%: m = 3 Dim R% Set S = Sheets("Summary") With S .Cells.Clear For Each Cus In Sheets If Cus.Name Like "Customer" & "#" Then R = Cus.Range("B9").CurrentRegion.Rows.Count Cus.Range("B9").CurrentRegion.Copy .Cells(m, 1) With .Cells(m - 1, 1) .Value = Cus.Name .Interior.ColorIndex = 6 End With m = m + R + 2 End If Next Cus .Range("C:C,D:D,H:H").EntireColumn.Delete End With Application.ScreenUpdating = True End Sub الملف مرفق My project.xlsm

جرب كده نسخة_من_تطبيق_فرق_السعر_هيئة.xlsm

مشكور وما قصرت وبيض الله وجهك استاذي القدير

وعليكم السلام-جرب هذا ولا يوجد سوى ذلك https://business.tutsplus.com/ar/tutorials/convert-google-sheets-to-excel-spreadsheets--cms-30503

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

موفق اخي الفاضل من دواعي سروري حصولك على الحل المطلوب

وعليكم السلام تفضل جرب المرفق ehab2.xlsm

في الطريقة السابقة سوف تجد ان حقل id سوف يكون مكرر لبعض السجلات نفس الترقيم للسجلات السابقة فاذا رغبت في ترتيب تلقائي غير مكرر نستبدل استعلام 2 الخاص بانشاء جدول الى استعلام الحاق ونقوم بانشاء جدول tbl4 فارغ ثم ننفذ استعلام الحاق INSERT INTO tbl4 ( n_name ) SELECT استعلام1.n_name FROM استعلام1; انظر المرفقات توحيد.accdb

كما تعلم أن الكمال المطلق لا يكون الا لله سبحانه ووجود ما هو حماية مطلقة لا اعتقد انه شئ موجود علي أرض الواقع - لم احب أن اقول شئ مستحيل حتي لا تصاب بالاحباط - ولكن قوة وسلامة اجراءاتك المتخذة ستجعل الأمر صعب أول قل ان شئت شبه مستحيل علي المبتدئين - مثلي - والمتوسطين وقبيل مرحلة الاحتراف. واكرر ما قال أستاذنا عصام ربيع في موضوع مشابه أيهما أسهل تعديل تصميم لغيرك أم انشاء تصميم جديد؟! بطبع اختيار انشاء تصميم جديد بالنسبة للمحترفين هو الخيار الأمثل من اضاعة الوقت في فحص وتحليل وفهم تصميم آخر ثم القيام بتعديله بعد ذلك. وازيدك اطمأنان: لا تقلق بشأن العبث ببرنامجك فمهما بلغ تصميمك لن يساوي شئ أمام برامج يتم بيعها بمئات أو آلاف الدولارات. (ولا تغضب مني بشأن هذا فأنا لا أقلل من قيمة عملك) ولكن أنبهك أن لمن عنده النية لتكريك برنامج لديه ما يصرفه عنك فهو انما يبحث عن الصيد الثمين! تمنياتي بالتوفيق

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

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

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

السلان عليكم اعتذر يا دكتور على التأخير كنت بأصلى اتفضل يا دكتور استخدم احد الكودين الاتيين على زر امر الترقيم Me.k = Nz(DMax("k", "t1", "[xdate] = #" & Format(Me.txtXdate, "yyyy/mm/dd") & "#" & "And [manager] = '" & txtManager & "'"), 0) + 1 'Me.k = Nz(DMax("k", "t1", "xdate=[Forms]![F1]![txtXdate]and manager=[Forms]![F1]![txtManager]"), 0) + 1 ولعدم تغيير القيمة ان وجدت بالحقل Select Case Nz(Me.k.Value, "") Case "" Me.k = Nz(DMax("k", "t1", "[xdate] = #" & Format(Me.txtXdate, "yyyy/mm/dd") & "#" & "And [manager] = '" & txtManager & "'"), 0) + 1 'Me.k = Nz(DMax("k", "t1", "xdate=[Forms]![F1]![txtXdate]and manager=[Forms]![F1]![txtManager]"), 0) + 1 Case Else Exit Sub End Select صل على رسول الله - صل الله عليه وسلم وعلى اله وصحبه يا دكتور هذا ما اريده فقط ولا اريد غير ذلك اما انت يا استاذى الجليل وسيدى الفضيل ومعلمى القدير يكفينى انك على اسم ابى فوالله لو طلبت كل ما املك فلن تجدنى الا ملك يمينك بكل ما املك احبكم فى الله ولوجه الله تعالى

تفضل يتم ذلك بمجرد الضغط على ترحيل كارت الصنف 2018 (1).xlsm

تفضل اخى الكريم كود الترحيل يعمل الأن معك المشكلة كانت لأنك لم تغير رقم الصفحة المرحل منها وهى 1 فى الشيت الجديد المرسل منك لأن ترتيبها اصبح الصفحة الثالثة وليست الأولى كما فى الملف القديم حساب عملاء.xlsm

تفضل Microsoft Excel Worksheet2.xlsm

جرب هذا بمجرد ادخال الرقم خطأ والضغط على انتر يقوم بمسح التكست بوكس Microsoft Excel Worksheet.xlsm

تفضل لا تقوم بالكتابة والإدخال اليدوى الا فى عمود ID/Iqama بالنسبة للجداول فى صفحات الشهور الانشطة.xlsx

تفضل لك ما طلبت كلمة السر :123 يمكنك تغييرها كما تريد من داخل الكود Microsoft Excel Worksheet.xlsm

لك ما طلبت اصناف.xlsm

تفضل اصناف.xlsm

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

اهلا بك فى المنتدى يمكنك رفع اى ملف تصورى لما تريد وشرح بالتفصيل ما تريد عليه

اخى الكريم لا تقلق ليس هناك اى مجال للخطأ لأن المعادلة ثابتة وتأخذ من البيانات المرحلة ويمكنك ايضا حماية الأعمدة التى بها معادلات حتى لا يعبث بها احد او يغير

يمكن عمل الكودين فقط فى حالة اذا تم فتح صفحات بإسم الصنف ولكن انصحك بعمل ملف اخر لهذا الطلب أفضل لأنه كلما زاد من حجم الملف الواحد كلما ثقل وصعب العمل بكفاءة تفضل الملف بعد تحرير عمود السعر 11حساب العملاء(1).xlsm

اهلا بك اخى الكريم تفضل تم ضبط الملف ولكن عليك فتح الصفحات الذى تريدها للأصناف المطلوبة بأخذ كوبى من الصفحة المفتوحة ,وعمل نفس المعادلات للصفحة الجديدة كما هو الحال فى المعادلات الموجودة بصفحة Reference للصنف المفتوح حاليا وهو 15003 بارك الله فيك كارت الصنف 2018 (1).xlsm

اهلا بك اخ كريم فى المنتدى لك ما طلبت 11حساب العملاء.xlsm

اخى الكريم كل البيانات الناتجة تمام بالنسبة للمعطيات فعل سبيل المثال ليس للصف الأول المتوسط اجمالى اقساط للمدرسة م8 ,فمنطقى ان لا يعطى نتيجة ,فلمل تقول النتائج غير دقيقة النتائج بالنسبة لما هو معطى مع المعادلة 100 % صحيحة ولكن سأنفذ لك الملف على المرحلة فقط كما تريد تفضل لك ما طلبت اقساط طلاب.xlsx

تفضل الملف بعد التعديل PubsLite.rar

Message Boxes في المرفقات منقول Message Boxes.rar

تفضل وحدة نمطية مع الشرح يمكن من خلالها طباعة الصفحات من تقريرين تنازليا مهما بلغت الصفحات وايضا يمكن تحديد نقطة البداية او صفحة البداية فلو فرضنا ان لديك تقريرين كل واحد منهما يحتوي على 100 صفحة وتريد ان تبدأ الطباعة من الصفحة رقم 20 تنازليا فكل ما عليك هو ان تضع رقم صفحة البداية في الحقل المخصص في النموذج افتح محرر الفيجوال والصق الوحدة النمطية التالية : Function PrintDscOrder(Rep1 As String, Rep2 As String) Dim PgNum As Integer, _ PgNum2 As Integer, PagesCnt As Integer 'اعلان عن متغيرات رقمية تمثل مجمل الصفحات وارقام الصفحات المحددة PagesCnt = Me.RepageCnt.Value 'مجمل الصفحات = قيمة الحقل في النموذج For PgNum = PagesCnt To 1 Step -2 'دوارة تنازلية زوجية PgNum2 = PgNum - 1 'تحديد رقم الصفحة الثانية وهي هنا اقل من الحالية بواحد DoCmd.SelectObject acReport, Rep1, True 'تحديد التقرير الأول DoCmd.PrintOut , PgNum, PgNum2, 1 'طباعة الصفحات المحددة DoCmd.SelectObject acReport, Rep2, True ' تحديدالتقرير الثاني DoCmd.PrintOut , PgNum, PgNum2, 1 'طباعة الصفحات المحددة Next PgNum 'عودة لبداية الدوران End Function 'تصميم وترتيب ابوخليل وفي حدث بعد النقر لزر الطباعة الصق السطر التالي : Call PrintDscOrder("استقطاعات", "استحقاقات") طباعةالصفحات تنازليا من تقريرين.rar

سأعرض الحل هنا مع توضيح بعض النقاط المهمة فالجملة البرمجية التي تستخدم لفتح ثم طباعة الصفحات المحددة من التقرير DoCmd.OpenReport stDocName, acPreview DoCmd.PrintOut acPages, pageFrom, pageTo لا تقوم بالمهمة كما ينبغي وكما رسمت له فمن المعلوم ان تنفيذ هذا الكود سيكون من خلال النموذج لذا يصعب التنفيذ بل يمتنع وتظهر بعض العقبات غير المتوقعة فمنها : - طباعة النموذج بدلا من التقرير وقد يتم طباعة الاثنين معا - عدم طباعة الصفحات المحددة وانما يتم طباعة الجميع - هذا الكود يقوم بفتح التقرير وهذه مشكلة بحد ذاتها حيث يستلزم اخفاؤه او تصغيره ثم غلقه وهل هناك بديل ؟ نعم وهو يقوم بكل لطف وصمت بطباعة صفحات محددة من تقارير عدة والحل سطران فقط ومن اراد الزيادة فعليه ان يكررهما ما شاء الاول يقوم بتحديد التقرير لا فتحه DoCmd.SelectObject acReport, "استقطاعات", True والثاني لطباعة الصفحات المحددة DoCmd.PrintOut , 14, 13, , 1 رقم 1 يمثل عدد النسخ في المرفقات تحقيق وتطبيق طباعة واختيار الصفحات من عدة تقارير.rar