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

وعليكم السلام 🙂 تفضل: Private Sub Command4_Click() Call ApendData("MyTable", Me) End Sub Function ApendData(strTableName As String, frm As Form) Dim db As DAO.Database Dim rs As DAO.Recordset Dim ctl As Control Set db = CurrentDb() Set rs = db.OpenRecordset(strTableName) rs.AddNew For Each ctl In frm.Controls If ctl.ControlType <> acLabel And ctl.ControlType <> acCommandButton Then rs.Fields(ctl.Name) = ctl.Value End If Next ctl rs.Update rs.Close End Function جعفر ApendDataByRecordset.zip

السلام عليكم 🙂 في النموذج المستمر ، لا يمكن عمل شيء لحقل دون آخر ، إلا استعمال التنسيق الشرطي 🙂 الطريقة الاخرى ، ان يكون هناك حقل لمسار للصور: هذا المجلد الذي فيه الصور . الاستعلام مصدر بيانات النموذج ، وفيه مسار الصور ، 1- يجب تغيير المسار يدويا ، 2- اسم الصورة هو دمج (مو جمع) الحقلين Completed و Printed . لاحظ اسم الملفات . والنتيجة . جعفر icons_3.zip

انا عن نفسي ، لم استخدم هذه الطريقة ابداً في اي من برامجي ، وإنما استخدم طريقة اكسس التقليدية 🙂 طبعا هذا لا يعني ان لا يكون هناك حالات خاصة في المستقبل قد استعملها فيها 🙂 بكلام آخر ، انا دائما استخدم طرق اكسس التقليدية : 1. استخدم ربط الجداول بالطريقة العادية ، 2. لا اعمل اخفاء للجداول والاستعلامات والنماذج و.. 3. استخدم قوائم زر الفأرة اليمين ، 4. واستخدم العمود الفقري وقوة الاكسس ، الاستعلامات العادية ، والجأ الى الكود وقت الحاجة ، 5. وووو جعفر

جزاكم الله خيـــــــرا اساتذتى العظماء وفكرتى المتواضعة على الطريقة الجعفرية كل الشكر استاذ @jjafferr لان الفكرة اصلا اكتسبتها منكم سابقا والحل الان منكم سيدى نقوم بعمل موديول عام Public Function IconByChk(ByVal strFieldNameA As String, ByVal strFieldNameB As String) IconByChk = CurrentProject.Path & "\ico\" & strFieldNameA & strFieldNameB & ".png" End Function ويتم استدعاءه فى الاستعلام img: IconByChk([completed],[printed]) واخيرا المرفق Show One img.zip

تم تعديل الطريقة الاولى ، بتسمية الاستعلام qry_Show_imgs1 ، والنموذج Form1 ، وتمت الاستفادة من جزئية من كود اخوي حسين @د.كاف يار لضبط المسار تلقائيا (مع اني جربته سابقا ولم يعمل لسبب ما!!) ، شكرا اخوي حسين 🙂 وتم اضافة طريقة ثانية للعمل ، بإضافة الصور الى جدول خاص بها (لأن الصور محدودة وصغيرة فلن تأثر كثيرا على حجم البرنامج) ، فما صرنا محتاجين الى صور خارج البرنامج ، وعليه ، الاستعلام qry_Show_imgs2 ، والنموذج Form2 ، يقومان بالعمل 🙂 جعفر 1501.2.icons_3.zip

تفضل هذه المشاركة مجلد جديد.rar

وهذي مشاركتي مع اخواني الأعزاء المحزن.accdb

اتفضل هذا التعديل cnbo (1).accdb

عن اسناذنا @د.كاف يارحيث انه استخدم عملية الفلترة التي يستدعيها عند فتح التقرير جرب الكود التالي واعتقد انه اقرب للفهم وهو يعمل مثل كود استاذنا انظر الى الشرط حين فتح التقرير DoCmd.OpenReport "Q_Accountant_Cat4", acViewPreview, , "[Cat4_Name] = '" & [Forms]![Q_Accountant_Cat4]![xxxxx] & "'"

تفضل التعديل cnbo.accdb

السلام عليكم ورحمة الله اليك تعديل كود ترحيل الناجحين و الراسبين اذا شعرت ان تنفيذ الكود يستغرق وقتا طويلا يمكنك طلب عمل كود جديد يعتمد على المصفوفات و لكن لضيق الوقت قمت فقط بتعديل الكود المرفق بالملف اما باقى المطلوبات فى وقت لاحق ان شاء الله اليك الكود و يجب ربطه بزر لتنفيذه فى اى وقت Sub Tarheel() Dim R As Integer, M As Integer, N As Integer Sheets("ناجح").Range("A11:Q1012").Clear Sheets("دور ثانى").Range("A11:R1012").Clear M = 10: N = 10 Application.ScreenUpdating = False Application.DisplayAlerts = False For R = 11 To 1012 If Cells(R, 14) = "ناجح" Then M = M + 1 Range("A" & R).Range("A1:Q1").Copy With Sheets("ناجح") .Range("A" & M).PasteSpecial xlPasteValues .Range("A" & M).PasteSpecial xlPasteFormats .Range("A" & M).Value = M - 10 End With Application.CutCopyMode = False ElseIf Cells(R, 14) = "دور ثانى" Then N = N + 2 Range("A" & R).Range("A1:R1").Copy With Sheets("دور ثانى") .Range("A" & N).PasteSpecial xlPasteValues .Range("A" & N).PasteSpecial xlPasteFormats .Range("A" & N).Value = (N - 10) / 2 End With Application.CutCopyMode = False End If Next MsgBox (" بحمد الله تم ترحيل الناجحين والدور الثانى") Application.DisplayAlerts = True Application.ScreenUpdating = True End Sub

السلام عليكم ورحمة الله وبركاته احيانا تحدث مشكلات عند تنفيذ احد الاجراءات تبعا للكود المستخدم فكرتى المتواضعة فى هذا المرفق 1- تسجيل الاخطاء ليقف المصمم , المطور , المبرمج على مكان الخطأ تحديدا ورقمه لسهولة حل المشكلة 2- تجاوز الاخطاء كما يترائى لـ المصمم , المطور , المبرمج من خلال الأخطاء التى تم تصيدها وتسجيلها بالجدول Write Error Log .mdb

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

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

لطفا اين تريد وضع كود الترتيب فى نموذج

هات مرفق

تفضل اخي الكريم جرب التعديل ووافنا بالنتيجة Function FunModulePermissions() On Error GoTo Macro1_Err With CodeContextObject If DCount("ID", "Tbusers", "deCode([UName],'User')='" & Trim(User) & "'") = 0 Then MsgBox " لا تملك الصلاحيات للدخول ", vbCritical + vbMsgBoxRight, "تنبيه" DoCmd.CancelEvent If CurrentProject.AllForms("FrmMain").IsLoaded = False Then .AllowAdditions = False .AllowEdits = False .AllowDeletions = False Else If (Forms!Frmmain!UAddData = False) Then .AllowAdditions = False End If If (Forms!Frmmain!UEditData = False) Then .AllowEdits = False End If If (Forms!Frmmain!UDeleteData = False) Then .AllowDeletions = False End If End If End If Macro1_Exit: Exit Function Macro1_Err: MsgBox Error$ Resume Macro1_Exit End With End Function

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

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

التعديل حسب فهمى لطلبك لو تقصد غير ذلك انذاك سوف تحتاج ان تقدم تفسيرا مفصلا لطلبك cnbo (1).accdb

مربع اختيار غير منضم فى نموذج مستمر

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

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

الآن عندك بحر من الحلول 🙂 هلا والله بالمتواضع 🙂 جعفر

بارك الله فيك يا طيب

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

ضع هذا الكود في جميع النماذج و التقارير في حدث عند الفتح If DCount("ID_User", "users", "deCode([UName],'User')='" & Trim(user) & "'") = 0 Or _ Me.AllowDeletions = False Then _ MsgBox " لا تملك صلاحيات لذلك ", vbCritical: Exit Sub يجب ان يتحقق الشرط - وجود اسم مستخدم صحيح - وجود صلاحية

جميل استاذي العزيز

حياك الله وجدت ان كلمة "جدة " يوجد بعدها مسافة امسح المسافة بعد الكلمة لتصبح "جدة" تفضل تنسق شرطي معدل1.xlsx

مشكور جدا على هذا الكود الرائع

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

بسم الله الرحمن الرحيم السلام عليكم ورحمة الله وبركاته هذا برنامج جمعية خيرية برجاء من السادة مستخدمي الموقع أن يرشدني إلى بعض عيوب هذا البرنامج ولهم الشكر https://drive.google.com/drive/folders/1J4Vl9sfPYTVpIPyyY7pcyBdEU0xuSLWy?usp=sharing

السلام عليكم اليك اخى الملف لعله يفى بالمطلوب تنسق شرطي.xlsx

تستطيع التحكم في الوقت عن طريق تغيير القيم في الجدول الايسر تفضل جرب المرفق تنسق شرطي معدل.xlsx

يمكنك استعمال هذه المعادلة =LEFT(B1,4)-LEFT(A1,4)+1 حيث A1 و B1 بهما العامين من الأقدم للأحدث بالتوفيق

Sub Test() Dim x, temp, myDir As String, fn As String, wsName As String myDir = ThisWorkbook.Path & "\" fn = "B.xlsx" wsName = ActiveSheet.Name If Dir(myDir & fn) = "" Then MsgBox "Workbook Not Found", vbExclamation: Exit Sub On Error Resume Next x = ExecuteExcel4Macro("'" & myDir & "[" & fn & "]" & wsName & "'!R1C1") temp = Err.Number On Error GoTo 0 If (temp = 0) * (Not IsError(x)) Then With ActiveSheet.Range("A1:A8") .Formula = "='" & myDir & "[" & fn & "]" & wsName & "'!F4" .Value = .Value End With Else MsgBox "Worksheet Not Found", vbExclamation End If End Sub

تفضل هذا المثال الاجنبي قد يفي بالغرض Microsoft Access Calendar Form Template [Access-Templates.Com].accdb

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

وعليكم السلام-تفضل نظام_الملاك_2019.xlsm

وعليكم السلام-لك ما طلبت بيان1.xlsx

اعرض الملف الاتصال بالجداول الخلفية لقاعدة بيانات او اكثر من قاعدة والتنقل بينهم السلام عليكم ورحمة الله تعالى وبركاته اهديكم واضع بين اياديكم هذا المثال والذى من خلاله يتم الارتباط بقاعدة / او عدة قواعد خلفية دفعة واحدة والتنقل فيما بينهم برمجيا آلية العمل -عمل اختبار للاتصال بالقاعدة الخلفية وإذا فشل الاختبار ينتقل للمرحلة التالية - البحث اليا عن المجلد الاصلى بجوار قاعدة البيانات الامامية فى حالة وجوده يرتبط اليا بجميع القواعد بداخله بمجرد الموافقة على ذلك من خلال الرسالة أو يمكنك تغير المسار للبحث بنفسك واحضار قاعدة الخلفية او القواعد إن زاد عددهم عن واحدة بمجرد اختيار المجلد الموجودة به -المرجلة التالية هى تأكيد واختيار القاعدة /أو القواعد والتى تخص هذه القاعدة الأمامية -المرحلة التالية بعد تأكيد اختيار القواعد فى هذه المرحلة والأخيرة نختار القاعدة التى نتصل بها وان كانت تحتوى على كلمة مرور نكتبها فى المكان المخصص لذلك وهنا على سبيل المثال قاعدة الخلفية ArchivingTables2018 تم عمل باسورد لها للتجربة وهو 2018 اما القاعدة ArchivingTables2019 لم يتم عمل باسورد لها وكما تشاهدون فى الصورة تم التنقل بكل سهولة وبكل اريحية بين القاعدتين هناك ميزة اخرى ولكن لم استطع تجربتها وهى الاتصال كذلك بجهاز كمبيوتر اخر والذى يحتوى على قاعدة الخلفية فى حالة الشبكة المحلية وذلك بكتابة اسم مستخدم الجهاز كلمة المرور المخصصة للاتصال بالجهاز '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' ' _ +--officena------oOo-------oOo--------+ _ ' ' /o)| |(o\ ' ' / / | منتــديات اوفسيـنا | \ \ ' ' ( (_ | _ _ | _) ) ' ' ((\ \)+-/o)----oOo----oOo---------------(o\-+(/ /)) ' ' (\\\ \_/ / \ \_/ ///) ' ' \ / \ / ' ' \____/ \____/ ' ' ===============================oOo----oOo============ ' ' ----{ By Mohammed Essam )---- ' ' ----{ www.officena.net/ib/profile/129737-ابا-جودى )---- ' ' ======================oOo-------oOo================== ' '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' فى انتظار تجربتكم وابداء آرائكم القيمة وأبداعاتكم بأفكاركم الرائعة ☺ Automatically relink Access tables.rar Automatically relink Access tables.zip صاحب الملف ابا جودى تمت الاضافه 31 مار, 2019 الاقسام قسم الأكسيس

Combo_with first_Letters.xlsm

السلام عليكم ادين بالفضل لهذا المنتدى العظيم .. تعلمت منه الكثير واحب ان اشارك فى هذا الشهر الكريم بهذا العمل المتواضع لكيفية انشاء قوائم منسدلة بياناتها مرتبطة ببعضها البعض Sub Lists عن طريق VBA .. وكل عام وانتم بخير sub lists with vba.rar

تم رفع هذا الكود فى مشاركة منفصله حتى لا ننسى هذه المشاركة قائمة منسدلة مع البحث بحساسية الاحرف تم ارفاق كود الحل من الفاضل _ أ / أبوعبد الله مع الملفات بحث عن صنف واختياره بفورم.rar شرح اختيار من قائمة منسدلة.rar _ بحث بقاائمة.rar مشاركة اخرى من الفاضل _ أ / ياسر خليل أبو البراء مع الملفات Baraa_Lists.rar _ TestLists.rar مشاركة اخرى من الفاضل _ أ / الخالدي مع الملفات قائمة منسدلة.rar و لا تنسونا من صالح الدعاء

تم رفع هذا الكود فى مشاركة منفصله حتى لا ننسى هذه المشاركة فوم ادخال بحث تعديل حذف وفلترة للبيانات تم ارفاق كود الحل من الفاضل / basem said و لا تنسونا من صالح الدعاء سريع (1).rar

السلام عليكم اخي الكريم جرب التالي For h = 0 To ListBox1.ListCount - 1 Sum = Sum + Val(ListBox1.Column(4, h)) Next TextBox2 = Sum