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

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

اشكر جميع الاخوة الاعزاء على الاطراء والثناء مسفر وحلبي وقاسم وعبداللطيف و ابو آمنة و athal وعلى كل من مر من هنا وواستفاد واشكر ابا جودي حيث سبقني للتوضيح وشكرا للأفكار النيرة بالنسبة للشفرة المكتوبة عند فتح النموذج فهذا قام به المعالج في اكسس 2003 حين اخترت الزر فقد كفاني المشقة وكتب لي ما ترون ولكني احيانا اكتبها بسطر واحد كما تفضلتم تجدون ادناه شرح لاسطر الكود وبعض الملاحظات Private Sub cmdshow_Click() On Error GoTo Err_cmdshow_Click 'عند الخطأ اذهب الى تفاصيل الخطأ Dim stDocName As String ' اعلان عن متغير نصي يمثل اسم الفورم Dim stLinkCriteria As String ' اعلان عن متغير نصي يمثل المعيار او الشرط stDocName = "frmain" DoCmd.OpenForm stDocName, , , stLinkCriteria ' هنا وضعنا المعيار رغم انه لا يحمل قيمة Exit_cmdshow_Click: ' سطر الخروج Exit Sub ' اخرج من الحدث Err_cmdshow_Click: ' تفاصيل الخطأ MsgBox Err.Description ' رسالة تحتوي على تفاصيل الخطأ Resume Exit_cmdshow_Click ' ارجع الى سطر الخروج ' -------------------------------------------- 'DoCmd.OpenForm "frmain", acNormal ' يمكن الاكتفاء بهذا السطر عن كل ما سبق ' ولكن الاخطاء ستظهر في حال وجودها ولكن بدون تفصيل ' End Sub اما السطر : on error resume next فأنصح بعدم استخدامه مطلقا الا في حدود ضيقة للضرورة وهي عند وجود اخطاء منطقية وظيفة هذا السطر انه يقفز ويتخطى الأخطاء ففي مثال الاخ عبد اللطيف لو حدث خطأ فإنه سيقفز الى end sub وينهي الحدث وحينها لن يفتح النموذج ولن تعرف السبب

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

لا يمكن العمل حسب الجدول الذي وضعته لان، السنوات تخلتف من عامود الى اخر افترح عليك هذا الملف test_monthly.xlsx

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

جرب هذا الكود Option Explicit Sub COLORIZE_CELLS() Dim CEL As Range With Range("B7:K13") .ClearContents .Interior.ColorIndex = xlNone End With For Each CEL In Range("L7:U13") If CEL <> vbNullString Then With CEL.Offset(, -10) .Value = CEL .Interior.ColorIndex = 6 End With End If Next End Sub الملف مرفق Auto Writing.xls

Private Function IsDplcateRec() As Boolean IsDplcateRec = False If IsNull(DLookup("SuID", "Contacts_T", "SuID=" & Me.SupplierID)) = False Then IsDplcateRec = True Else CurrentDb.Execute "INSERT into Contacts_T([SuID]) VALUES (" & SupplierID & " )" End If End Function Private Sub cmd_Click() On Error Resume Next Dim Lst As String Lst = DLast("SuID", "Contacts_T") + 1 If IsDplcateRec Then MsgBox _ " الرقم المدخل موجود في الجدول وهو : ( " & [SupplierID] & " )" CurrentDb.Execute "INSERT into Contacts_T([SuID]) VALUES (" & Lst & " )" MsgBox _ "تم اضافة سجل جديد برقم : ( " & [Lst] & " )" End If End Sub الكود يقوم بـ يفحص اذا كان الرقم المدخل موجود يخبرك انه موجود وسيتم إضافة سجل باخر رقم مووجود في الجدول +1 بخصوص التحديث في جدولين فقط استخدم الامر CurrentDb.Execute "INSERT into Contacts_T([SuID]) VALUES (" & Lst & " )" مع استبدال المتغيرات حسب حاجتك اليك ملف تجريبي = fix-07-07-2019.accdb

السلام عليكم نزولا عند رغبة احد الاصدقاء برنامج تسجيل الاقساط اوتوماتيك نقوم بتسجيل بيانات العميل كاملة ثم نكبس على الاقساط نفتح لنا شاشة جديدة نكبس على تسجيل الاقساط فتنزل الاقساط اوتوماتيك عند دفع القسط نقوم بتحويل الحالة من لم يتم الدفع الى تم الدفع ثم تكبس على تحديث بعد الدفع نستطيع الحصول على كشف حساب للعميل أتمنى لكم الفائدة واتس أب 00962787787573 اقساط.accdb

فورم خاص للعمل على الجدول مع ترتيب الاسماء ابجدى الفيديو الصور

فورم بحث سريع وترحيل بيانات لصفحة اخرى الفيديو الصور

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

سلام عند تغيير اسم المندوب الى اخر لاتغير بيانات المندوب الاخر الرايط

السلام عليكم ورحمة الله وبركاته هل ممكن مساعدتي في عملية الجمع المدرجة في الصورة المرفقة كالتالي الجمع الموجود : 50 130 250 المطلوب هو 50 50-80=30 80-120=40 50 30 40 فهل ممكن المساعدة في ذلك اسم الجدول: Vehicle Recipient اسم الحقل: KM_No الدالة المستخدمة حالياً: DSum: DSum(" [KM_No] ","Vehicle Recipient","[ID2]<=" & [ID2] & " ") أرجو الإفادة والمساعدة في ذلك مع الشكر الجزيل

السلام عليكم من فضلكم هل لي بمساعدة في انشاء فورم تسجيل الدخول وصلاحيات 04 مستخدمين لبرنامجي تسيير الموظفين جزاءكم الله خير الموظفين.rar

فورم البحث بالرقم بطريقتين مع عدم اغلاق الفورم الا بعد الموافقة الفيديو الصور

ياريت ترفع مثال

لو مربطين مع بعض هايشتغل على الاتنين

تفضل Private Sub Form_Load() DoCmd.RunCommand acCmdRecordsGoToLast End Sub

المعادلة لا تكتشف اي تنسيق ولا تعرف ولا تتعرف على لون الخلية او نوعية الخط فيها او قياسة او اي تنسيق اخر انها تنظر فقط الى محتوى خلية معينة او نطاق معين بغض النظر عن التنسيق Bold Font,Underline ,.interior Color الخ....) مثلاً معادلة IF تجيبنا عن سؤال (هل الخلية A5 تساوي 3 او أكبر من 10 او تحتوى على نص معين او فارغة) لماذا نطلب من المعادلة ما لا تقدر ان تقوم به كيف تقول للمعادلة اذا كان لون الخلية الفلانية احمر اعطني "OK" والا اعطني "No Red" مثلاً ربما هذا الكود يقوم بذلك Private Sub Worksheet_Change(ByVal Target As Range) Dim CEL As Range Application.EnableEvents = False If Not Intersect(Target, Range("L7:U13")) Is Nothing _ And Target.Count = 1 Then Range("B7:K13").ClearContents For Each CEL In Range("L7:U13") If CEL.Offset(, -10).Interior.ColorIndex = 6 Then CEL.Offset(, -10) = CEL End If Next End If Application.EnableEvents = True End Sub Auto Writing1.xls

أعزائي الملف المرفق للتعديل https://up.top4top.net/downloadf-12835f2id1-7z.html ولكم كل الشكر والإمتنان

راجع هذا الرابط ، والذي فيه رابطين وهذا جعفر

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

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

وجهة نظري المتواضعه انه هناك أمور يعرفها الاخ @ابوخليل ونحن نجهلها لذلك سننتظر رأيه وشرحه للموضوع ونستفيد نحن متعودون على كتابة on error resume next docmd.openform"formname",acnormal

السلام عليكم جميعا احبتي لماذا استخدم استاذنا ابو خليل الكود التالي لفتح النموذج ولم يكتفي ب Docmd.open form "frmain"

تفضل الحل في المرفق... المصنف01.xlsx

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

نزل مثال للتطبيق عليه أفضل هيك ما اتوقع حدا رح يساعدك

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

السلام عليكم جميعا ، اقدم لكم برنامج الاول لمراقبة وسداد الاقساط...ونبذة عن البرنامج : 1:مجانى تماما 2:يصل تسجيل العملاء فيه الى5004عميل 3:الحجم خفيف جدا وهو مصمم عالاكسل وسهل الاستخدام وسريع ، 4:فورم دخول بكلمة مرور وهى (12345) ، 5:يحتوى على عدة صفحات منها : أ:الصفحة الرئيسية ، ب:صفحة العملاء "لتسجي بيانات العملاء فيها" ، ج:صفحة حالة العملاء لمراقبة حالة السداد وهى بحالات مثلا تكون الحالة : ١:اوشك على السداد اذا مر٢٧يوم من تاريخ اخر سداد للعميل باللون الاصفر ، ٢:متاخر اذا مر اكثر من٣٠يوم باللون البرتقالى ، ٣:متاخرجدا اذا مر اكثر من٦٢يوم باللون الاحمر ، ٤:وحالات اخرى منها لم يستحق ويقدم للشكوى ، د:صفحة بحث وترحيل "وفيها تقوم بالبحث عن العميل باى حرف من اسمه او من السلعة المباعة له او عنوانه او ان كان ضامن له ويتم سداد قسط العميل منهاوتستطيع تغيير قيمة القسط الافتراضية و لاغراض اخرى . . . " ، ع:صفحة عمليات السداد للعمليات المسددة ، غ:صفحة استعلام مختصر وتكون ب البحث بالكود "يتم جلب كل بيانات العميل بالمدفوع" ، ف:صفحتين فارغتين "ليقوم المستخدم باستخدامهما كيف يشاء" ، ق:صفحة كلمات المرور والصلاحيات "وتقوم فيها بالتعديل على كلمات المرور واعطاء صلاحيات الدخول لكل مستخدم و تغيير اسم المنشأة واسم المدير ليظهرا بالرئيسية وايضا اسم المستخدم يظهر بالرئيسية وفيها تقارير بسيطة للبرنامج ، واخيرا "الدال على الخير كفاعله" والسلام عليكم ورحمة الله وبركاته برنامج الأول للاقساط..xlsm.zip

جاري التجرية

هات مثالاً عما تريد (الأفضل تضليل لعدم الدخول في مشاكل الــ Shapes ) و خذ ما يدهش العام

رائع استاذ سليم تحياتي وتقديري

اتفضل الملف لعله يفى بالفرض بعد فك تشفير الباسورد نسخة من property_investment_return-1.xls

أيضا تعلمت شيء من هذا العمل المبارك هو : كلما نضج المبرمج وزاد علمه حاول اختصار أعماله وبرنامجه من الحقول والجداول والنماذج والاستعلامات والتقارير . فيخرج العمل صغير الحجم كبير النفع . وهذا ما يصنعه علماء الشريعة الإسلامية حينما يختصرون الفنون في المتون العلمية لطلاب العلم ليحفظه كما يقال ( من حَفِظَ المُتُون حَازَ الفُنُون ) من زاد علمه وتفحصه وكثر نظره وعطاءه في البرمجة حاز فنونها

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

بالاعتماد على نفس الكود الذي وضعته لك في مشاركة سابقة مع بعض التعديلات تفضل Dim File_Path As String Dim File_Name As String Dim Name_Path As String Dim Fso As Object Dim NewPath As String Set Fso = CreateObject("scripting.filesystemobject") File_Path = Application.CurrentProject.Path & "\CONTACT\" NewPath = Application.CurrentProject.Path & "\CONTACT\Old\" File_Name = Dir(File_Path & "\*.*") Name_Path = File_Path & File_Name If InStr(File_Name, crn) > 0 Then MsgBox (" * تم ايجاد تطابق بين رقم كذا والملف - سيتم نقله * ") Fso.MoveFile Name_Path, NewPath Else MsgBox (" * لا يوجد ملفات لنقلها * ") End If MoveFile.mdb CONTACT.rar

تفضل تم عمل 90% من التأسيس لاحظ ان اسماء الطوابق والغرف ثابت ليس للمستخدم صلاحية عليها اما السرير فنحن نتعامل مع المعرف (الآي دي) وليس مع رقم السرير فهنا رقم السرير بمثابة اسم السرير وكل مستخدم يمكنه تسمية السرير بما يفهمه هو فمثلا بالمثال قمت بتسمية السرير بثلاثة ارقام تمثل من اليسار : الطابق/ الغرفة / رقم السرير عملت استعلام اختبار لاظهار المتاح من الأسرة شروط المتاح حسب التالي : 1- ان يكون خيار متاح مفعل 2- ان يكون حقل تاريخ البداية فارغ // أو // يوجد تاريخ في حقل النهاية واعذرني مستقبلا فيما لو لم ابادر بالرد لأني احتاج لنقل المثال بسبب الاصدار الى جهاز آخر sakan.accdb بقي ان تضيف حقل (نعم/لا) بجانب حقل نهاية التاريخ فحين يتم ادخال تاريخ الخروج يتم ايضا التعليم على حقل : نعم بحيث نضعه ايضا ضمن المعايير حتى لا تظهر الاشغالات المنتهية السابقة

الرد على السؤال الاول يجب منع وضع x في أكثر من خلية واحدة من الأعمدة 0،1،2،3 لكل موضوع قمت بوضع ملف نموذج صغير (صفحة salim) يستجيب لهذا التساؤل ممكن نسخ الكود والتعديل عليه بما يناسب الصفحة والنطاق التي يجب العمل عليها Option Explicit Private Sub Worksheet_Activate() data_validation End Sub Rem""""""""""""""""""""" Rem =====>Created By Salim Hasbaya on 4/7/2019 ' How to prevent the User from writing Duplicate ' In Given Range Sub data_validation() Dim k% Dim t With Sheets("Salim") Dim single_RG As Range Dim LR%: LR = .Cells(Rows.Count, 2).End(3).Row - 5 Dim my_rg As Range Dim sub_rg As Range Set my_rg = .Range("b9:q" & LR) For k = 2 To 17 Step 4 Set single_RG = .Range(Cells(9, k), Cells(LR, k + 3)) Select Case single_RG.Cells(1, 1).Address(0, 0) Case "B9": Set sub_rg = Range("b9:E" & LR) Case "F9": Set sub_rg = Range("E9:I" & LR) Case "J9": Set sub_rg = Range("J9:M" & LR) Case "N9": Set sub_rg = Range("N9:Q" & LR) End Select '====================== Select Case single_RG.Address(0, 0) '+++++++++++++++++++++++++++++ Case "B9:E" & LR With single_RG.Validation .Delete .Add Type:=xlValidateCustom, _ Formula1:="=COUNTIF($B9:$E9" & "," & "B" & 9 & ")<=1" End With '++++++++++++++++++++++++++++++ Case "F9:I" & LR With single_RG.Validation .Delete .Add Type:=xlValidateCustom, _ Formula1:="=COUNTIF($F9:$I9" & "," & "F" & 9 & ")<=1" End With '+++++++++++++++++++++++++++++ Case "J9:M" & LR With single_RG.Validation .Delete .Add Type:=xlValidateCustom, _ Formula1:="=COUNTIF($J9:$M9" & "," & "J" & 9 & ")<=1" End With '+++++++++++++++++++++++++++++ Case "N9:Q" & LR With single_RG.Validation .Delete .Add Type:=xlValidateCustom, _ Formula1:="=COUNTIF($N9:$Q9" & "," & "N" & 9 & ")<=1" End With End Select '========================== Next Set my_rg = Nothing: Set sub_rg = Nothing Set single_RG = Nothing End With End Sub بالنسبة للسؤال الثاني لم استطع فهم ماتريد (يرجى حذف عمليات دمج الخلايا) الملف النموذج مرفق Salim_Data_val.xlsm

ايضا يمكنك استعراض الاسرة الاخرى في الغرفة وأسماء الموظفين فمثلا يوجد سريرين شاغرين في غرفتين ، هنا يمكننا عرض الساكنين ، لاتاحة الفرصة له للإختيار

- جدول لبيانات الموظفين - جدول لبيانات السرير (رقم السرير ، الحالة ، رقم الغرفة ، رقم الطابق) - جدول فرعي لتسجيل كل من يمر على السرير (رقم السرير /رقم الموظف / تاريخ الاشغال / تاريخ الانتهاء ) _______________________ الحالة : هي ارقام تعبر عن حالة السرير ( مشغول / شاغر / صيانة / ملغى / ) وهكذا ... تحليل البيانات يتم حسب الفكرة المطروحة

السلام عليكم لم أجد ما ذكرته في مشاركتك المقتبسة وإنما يعمل الملف المرفق من طرف أخي الكريم Ali Mohamed Ali بصورة جيدة وسليمة.... بن علية حاجي

السؤال هنا هل ان الحصة كل موظف مستقلة عن قيمة الدخول او لا مثلاً اذا كانت حصة علي 500 اذا كان الدخول 1000 هل هي نفسها (500) اذا كان الدخول 5000 اذا كان ذلك صحيحاً هذه المعادلة في الخلية J3 وتسحب نزولاً =IF(COUNTIF($E$8:$E$47,$I3)=0,"",COUNTIF($E$8:$E$47,$I3)*(VLOOKUP($I3,{"علي",500;"إبراهيم",1000;"محمد",750;"موسى",250;0,0;0,0;0,0;0,0;0,0;0,0;0,0;0,0;0,0;0,0;0,0;0,0;0,0;0,0},2,0))) اذا لم تعمل المعادلة استبدل الفاصلة ", " بفاصلة منقوطة";" (خارج الأقواس المعكوفة { } ) لتبدو المعادلة هكذا =IF(COUNTIF($E$8:$E$47;$I3)=0;"";COUNTIF($E$8:$E$47;$I3)*(VLOOKUP($I3;{"علي",500;"إبراهيم",1000;"محمد",750;"موسى",250;0,0;0,0;0,0;0,0;0,0;0,0;0,0;0,0;0,0;0,0;0,0;0,0;0,0;0,0};2;0)))

وعليكم السلام تفضل لك ما طلبت-كما يمكنك زيادة اعداد الموظفين كما تشاء فى جدول البيانات المعطاة المصنف6.xlsx

وعليكم السلام هذه 6 طرق ، برسائل وبدون ، وانا اخترت لك آخر واحدة منها ، وهي تعطيك شريط في اسفل شاشة الاكسس: . Option Compare Database Private Sub أمر10_Click() On Error GoTo Err_أمر10_Click 'Dim stDocName As String 'stDocName = "q1" 'DoCmd.OpenQuery stDocName, acNormal, acEdit '1 العمل بصمت وبدون اشعارات ' CurrentDb.Execute ("q1") '2 العمل بصمت وبدون اشعارات ' DoCmd.SetWarnings False ' DoCmd.OpenQuery "q1" ' DoCmd.SetWarnings True '3 العمل بصمت وبدون اشعارات ، ولكن بوجود ساعة ترابية تشير الى وجود عمل ' DoCmd.Hourglass True ' DoCmd.OpenQuery "q1" ' DoCmd.Hourglass False '4 عمل اشعار ثابت لمدة 3 ثوان في اسفل الشاشة ' Application.SetOption "Show Status Bar", True ' Application.Echo True ' Application.Echo False, "الاستعلام يقوم بالتحديث" ' ' DoCmd.SetWarnings False ' DoCmd.OpenQuery "q1" ' DoCmd.SetWarnings True ' ' PauseTime = 3: Start = Timer ' Do While Timer < Start + PauseTime ' DoEvents ' Loop ' ' Application.SetOption "Show Status Bar", False ' Application.Echo True '5 عمل اشعار متغير لمدة 3 ثوان في اسفل الشاشة ' Application.SetOption "Show Status Bar", True ' SysCmd acSysCmdSetStatus, "الاستعلام يقوم بالتحديث" ' DoCmd.SetWarnings False ' DoCmd.OpenQuery "q1" ' DoCmd.SetWarnings True ' ' PauseTime = 3: Start = Timer ' Do While Timer < Start + PauseTime ' DoEvents ' A = A + 1 ' If A / 50 = Int(A / 50) Then B = B & " . " ' SysCmd acSysCmdSetStatus, B & "الاستعلام يقوم بالتحديث" ' Loop ' Application.SetOption "Show Status Bar", False ' SysCmd acSysCmdClearStatus '6 عمل اشعار متغير لمدة 3 ثوان في اسفل الشاشة Application.SetOption "Show Status Bar", True SysCmd acSysCmdInitMeter, "الاستعلام يقوم بالتحديث", 5000 DoCmd.SetWarnings False DoCmd.OpenQuery "q1" DoCmd.SetWarnings True PauseTime = 3: Start = Timer Do While Timer < Start + PauseTime DoEvents A = A + 1 SysCmd acSysCmdUpdateMeter, A Loop Application.SetOption "Show Status Bar", False SysCmd acSysCmdClearStatus Exit_أمر10_Click: Exit Sub Err_أمر10_Click: MsgBox Err.Description Resume Exit_أمر10_Click End Sub . وهذا الرابط فيه البرنامج المرفق ، يعني خذ منه الكود وخليه في برنامجك : http://www.access-programmers.co.uk/forums/attachment.php?attachmentid=32438&stc=1&d=1275923825 . . والنتيجة Notification بطريقة البرامج المحترفة ، فوق ساعة الكمبيوتر . جعفر 876.msg styles.mdb.zip BalloonToolTipSample.mdb.zip