Foksh

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

وعليكم السلام ورحمة الله وبركاته .. جرب هذا الكود بعد التعديلات على زر الفلترة :- Private Sub Cm1_Click() Dim filterCondition As String Dim formattedDate As String filterCondition = "" If Not IsNull(Me.tx1) Then If filterCondition <> "" Then filterCondition = filterCondition & " AND " End If filterCondition = filterCondition & "nom = '" & Replace(Me.tx1, "'", "''") & "'" End If If Not IsNull(Me.tx2) Then If filterCondition <> "" Then filterCondition = filterCondition & " AND " End If formattedDate = "#" & Format(Me.tx2, "MM/DD/YYYY") & "#" filterCondition = filterCondition & "moveDate = " & formattedDate End If If filterCondition <> "" Then Me.Filter = filterCondition Me.FilterOn = True Else Me.FilterOn = False End If End Sub في الكود تم استخدام دالة Replace لتأمين النصوص في حقل tx1 ضد الأخطاء الناتجة عن علامات الاقتباس المفردة . وتنسيق التاريخ فقط . اما في الكود التالي ، فقط استخدمت تنسيق التاريخ ؛ وبدلاً من استخدام علامة الاقتباس المفردة ' لتطويق النصوص ، استخدمت علامتي اقتباس مزدوجتين """ لتجنب أي مشكلات ناتجة عن وجود اقتباسات مفردة داخل النصوص . Private Sub Cm1_Click() Dim filterCondition As String Dim formattedDate As String filterCondition = "" If Not IsNull(Me.tx1) Then If filterCondition <> "" Then filterCondition = filterCondition & " AND " End If filterCondition = filterCondition & "nom = """ & Me.tx1 & """" End If If Not IsNull(Me.tx2) Then If filterCondition <> "" Then filterCondition = filterCondition & " AND " End If formattedDate = "#" & Format(Me.tx2, "MM/DD/YYYY") & "#" filterCondition = filterCondition & "moveDate = " & formattedDate End If If filterCondition <> "" Then Me.Filter = filterCondition Me.FilterOn = True Else Me.FilterOn = False End If End Sub

حسب تجاربي السابقة = نعم نعم يوجد طرق ملتوية لكسر حماية قاعدة البيانات نعم ، لكني لم اعمل بها

نعم يوجد بلا شك .. أولاً كلمة سر لقاعدة البيانات ( ولا أقصد الأكود VBA ) .. ثم حفظ قاعدة البيانات بامتداد Accde فقط !!!!!!! ولحماية جداولك وبياناتك ( سبق التطرق لهذه النقطة في عدة مواضيع في المنتدى )

نعم

أخي @سامر محمود ,, بالنسبة للنقطة :- فحلها بسيط وهو أن تضع معيار في الاستعلام Delay report في حقل "وقت الحضور" = >#9:30:00 AM# . أما في هذه النقطة :- فتستطيع باستخدام الاستعلام ان تحصي عدد تكرارات التأخير لكل موظف ، وأن تطبق لائحة العقوبات التي تريدها . وفي هذه النقطة قمت بإضافة بإضافة العقوبات حسب عدد التكرارات و إضافة عقوبات جديدة تستطيع حذفها كيفما تريد ) هذا الاستعلام يجلب لك الموظفين المتأخرين :- SELECT Att_Details.serial, Att_Details.[رقم الموظف], Att_Details.[اسم الموظف], Att_Details.[نوع الحركة], Att_Details.[تاريخ الحركة], Att_Details.[وقت الحضور], Att_Details.[وقت الانصراف], Att_Details.الفرق, Att_Details.الملاحظات FROM Att_Details WHERE Att_Details.[وقت الحضور] > #09:30:00 AM#; وهذا الاستعلام يقوم بعد تكرارات التأخير فقط :- SELECT Att_Details.[رقم الموظف], Att_Details.[اسم الموظف], Format(Att_Details.[تاريخ الحركة],"yyyy/mm") AS الشهر, Count(*) AS التكرار FROM Att_Details WHERE (((Att_Details.[وقت الحضور])>#12/30/1899 9:30:0#)) GROUP BY Att_Details.[رقم الموظف], Att_Details.[اسم الموظف], Format(Att_Details.[تاريخ الحركة],"yyyy/mm"); والإستعلام الأخير يقوم بعد التكرارات وبناءً عليها يطبق العقوبات :- SELECT Att_Details.[رقم الموظف], Att_Details.[اسم الموظف], Format(Att_Details.[تاريخ الحركة], "yyyy/mm") AS الشهر, COUNT(*) AS التكرار, IIf(COUNT(*) = 1, "إنذار", IIf(COUNT(*) > 1 AND COUNT(*) < 6, "ربع يوم", IIf(COUNT(*) > 5 AND COUNT(*) < 11, "نصف يوم", "خصم يوم"))) AS الإجراء FROM Att_Details WHERE Att_Details.[وقت الحضور] > #09:30:00 AM# GROUP BY Att_Details.[رقم الموظف], Att_Details.[اسم الموظف], Format(Att_Details.[تاريخ الحركة], "yyyy/mm"); والملف بعد التعديل :- Att - Copy.accdb

أخي @jo_2010 ، قمت بتعديل بسيط على ملفك ، وهو إضافة حقل جديد = PathPic في الجدول لتخزين المسار فيه بشكل صريح بدلاً من الطريقة التي يم فيها جلب مسار الملف لحذفه ، وأصبح الكود بعد تعديله في زر الحذف بالشكل التالي :- On Error GoTo HandleError Dim fileToDelete As String Dim response As VbMsgBoxResult Dim db As DAO.Database Dim sql As String Dim recordID As String Dim subFolderPath As String recordID = [Forms]![frm_sader_wared]![Pname].Value subFolderPath = CurrentProject.Path & "\AttachedFiles\" & recordID fileToDelete = Me.PathPic.Value If Not IsNull(fileToDelete) And Dir(fileToDelete) <> "" Then response = MsgBox("هل تريد حقاً حذف هذا الملف؟", vbYesNo + vbQuestion, "تأكيد الحذف") If response = vbYes Then Kill fileToDelete Set db = CurrentDb() sql = "DELETE FROM TblAttchedFiles WHERE id=" & Me.ID db.Execute sql, dbFailOnError On Error Resume Next RmDir subFolderPath On Error GoTo HandleError Me.Requery End If Else MsgBox "لا يوجد شئ لحذفه", vbExclamation, "خطأ" End If HandleExit: Exit Sub HandleError: Select Case Err.Number Case 94 MsgBox "لا يوجد شئ لحذفه", vbExclamation, "خطأ" Case Else MsgBox "خطأ رقم: " & Err.Number & vbNewLine & Err.Description, vbCritical, "خطأ" End Select Resume HandleExit وهذا ملفك بعد التعديل base_s_w.accdb

وعليكم السلام ورحمة الله وبركاته.. هل معنى كلامك أنك تريد ان يكون للعميل أ سعر للصنف أ في البيع مختلف عن سعر الصنف أ للعميل ب مثلاً 🥴 ؟؟؟؟ لم اقم بتحميل المرفق ، ولكن للتأكد من الفكرة التي طرحتها !!!

بعد مشاهدة الملف المرفق ، واختيار بيانات كما في الصورة وكانت النتيجة في التقرير = صفحة واحدة ، وقمت بتجربتها في الطباعة كملف PDF - لعدم وجود طابعة - وكانت النتيجة ورقة واحدة بانتظار تجربة أخرى لإفادتك بها ,,

ما شاء الله ، هذا يحتاج سهرة ومخمخة وحبتين بنادول ههههههههه حبذا لو دعمتنا بملف مرفق ليتمتع به أمثالي في كيفية التعامل والاستدعاء والتفاهم مع الكود

نقطة ضعف متعلقة بالإدارة وليست في تصميمك للبرنامج ، للأسف .. وإلا ما الفائدة من وجود البرنامج وإحصاء ايام الحضور .... الخ لجميع تصنيفات الاشتراكات !!

المفترض أنه عضو ذهبي أي يتم احتساب ايام الحضور فقط وهذا يعني أنه غير مقترن بتاريخ من / إلى ❗ هذه النقطة لها سلوكان ، الأول أن تكون مدة التعويض اختيارية حسب قرار الإدارة . أو الثاني وهو احتساب ايام التعويض ثلث مدة الإجازة ويجبر الكسر لأقرب عدد صحيح أو من خلال معادلة :- من 1 الى 3 = تعويض 1 يوم من 4 الى 6 = تعويض 2 يوم أكثر من 7 = تعويض 3 أيام ... إلخ. سأجعل الموضوع أكثر وضوحاً بمرفق بسيط وبيانات مختصرة وهمية .. مجرد اقتراحات 😇 .

كمشاركة في هذه النقطة . هذا ملف قديم من أحد المواضيع وتم تعديله بشيء بسيط حسب حاجة صاحب المشروع سابقاً ( وهو برنامج أرشفة كتب إلكتروني لمؤسسة ) .. بالبداية قم بتثبيت البرنامجين 1st و 2nd ثم في النموذج PDF .. اختر من القائمة نوع الملف الذي تريده ( Jpg , Pdf ) ثم رقم الكتاب والتاريخ ( تستطيع تغييرها حسب حاجتك ) ثم زر سحب PDF أما فيما يتعلق بزر إدراج PDF ، فهو لاختيار ملف PDF من الكمبيوتر الخاص بك . تمت تجربته سابقاً على ماسح ضوئي فيدر .. ولكن تحسباً لإختلاف نوع الماسح الضوئي أو الويندوز أو ظروف بيئة العمل ، قم بتجربته وإخبارنا بالنتيجة . ♻ التحميل من جوجل درايف

أيضاً كفكرة تحويل الاشتراك الزمني الى نقاط ، يتم تحويل الاشتراك ولنفترض الذي مدته شهر أي بمعدل زيارة أو جلسة كل يوم أي بمعدل 30 زيارة بحيث يتم احتساب الزيارات التي استخدمها المشترك ولنفترض استخدم من مدة الاشتراك اسبوع أي بمعدل 7 زيارات فيتبقى له 23 زيارة ، وهنا عند تسجيله الدخول والخروج سيتم خصم 1 من عدد الـ 23 فيتبقى له 22 زيارة وهنا سيكون الإشعارات لديك نوعان :- - الإشتراكات المحدودة أو الزمنية يتم التنبيه قبل اسبوع مثلاً. - الإشتراكات الغير محدودة أو الرصيدية يتم التنبيه قبل 7 زيارات مثلاً متبقية في رصيد المشترك. وهنا لو غاب المشترك شهرين فإن رصيده لن يتأثر بمدة الإنقطاع . 🔹 طبعاً هنا نستطيع الإستفادة من فكرة تحويل أو تحديث الإشتراك من زمني أو محدود إلى الغير محدود من ناحية مادية ( لصالح صاحب المنشئة ) موضوع تحويل نوع الإشتراك أمر يسير بلا شك ، واحتساب الرصيد المتبقي أمر أيسر إن شاء الله عليكم 😇 . هي مجرد أفكار بصوت عالٍ 🤗 .

كانت فكرتي في برنامجي سابقاً ، انه يتم تسجيل الحضور من خلال رقم المشترك الغير متكرر . وعند طلب أحد المشتركين ايقاف اشتراكه بشكل مؤقت لأسباب كالسفر مثلاً ، كنت اقوم بتفعيل Pause كحقل موجود في جدول تفاصيل الإشتراك للمشترك ، بحيث انه لنفترض ان المشترك طلب ايقاف عضويته لمدة غير محددة . فمن خلال الزر المسؤول عن تحديث الحقل من No الى Yes لهذا المشترك يتم ايقاف العضوية بحيث لو تم ادخال رقم المشترك في لوحة تسجيل الحضور تظهر رسالة ان المشترك في فترة انقطاع ، وكان الأمر يعود للمسؤول بأنه عند ادخال رقم المشترك في نموذج عرض تفاصيل حساب مشترك ، يظهر له ان هذا الحساب متوقف مؤقتاً ، فيظهر زر إعادة تفعيل بحيث انه عند النقر عليه يتم إحتساب مدة الإنقطاع من تاريخ التوقيف ( وهي قيمة كان يحدثها زر إيقاف الإشتراك مؤقتاً ) الى تاريخ التفعيل ويتم اضافة هذه الايام الى مدة الاستراك + إعادة قيمة حقل الحالة من Yes الى No مرة أخرى . أي أن الحساب غير مجمد أو موقوف . هذه هي الفكرة الأفضل التي وجدتها أثناء العمل وهي احتساب عدد الأيام ولكن بشكل ديناميكي . أي أنه لو اراد المشترك اعادة ايقاف الاشتراك مؤقتاً مرة أخرى فسيقوم الكود بتحديث حقل تاريخ الإيقاف المؤقت و حقل حالة الإشتراك من No الى Yes مرة أخرى . أتمنى أن أكون قد وُفقت في توضيح الفكرة .

مشاركة مع المهندس @Moosak ، وتطبيقاً لفكرته بعين أخرى . قم بإنشاء مديول جديد ، والصق به الكود التالي مع تغيير القيم حسب حاجتك .. Public Function CalculateMargin(Amount As Double) As Double Select Case Amount Case Is <= 100 CalculateMargin = Amount * 0.05 Case 101 To 200 CalculateMargin = Amount * 0.1 Case 201 To 300 CalculateMargin = Amount * 0.15 Case 301 To 400 CalculateMargin = Amount * 0.2 Case 401 To 500 CalculateMargin = Amount * 0.25 Case 501 To 600 CalculateMargin = Amount * 0.3 Case 601 To 700 CalculateMargin = Amount * 0.35 Case 701 To 800 CalculateMargin = Amount * 0.4 Case 801 To 900 CalculateMargin = Amount * 0.45 Case Else CalculateMargin = Amount * 0.15 End Select End Function الآن من خلال استعلام تحديث ان كنت تريد تحديث قيمة الحقل "هامش الربح" في جدولك . أنشئ استعلام تحديث ( Update ) ، وقم باختيار الجدول "2025" ، ثم اختر الحقل الخاص بهامش الربح = "هامش الربح" ؛ الآن في خانة تحديث إلى ( Update To) سيتم استدعاء الدالة من المديول السابق :- CalculateMargin([Price]) والنتيجة :- يتم ضرب قيمة السعر في النسبة المئوية التي حددناها في المديول . وهذا مثال بملف مرفق على الفكرة .. Database1.accdb

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

اخي الكريم ، ليس عليك ارفاق المشروع كاملاً .. فقط العناصر ذات الصلة في الطلب ، وقم بضغط الملف باستعمال برامج الضغط المعروفة .

وعليكم السلام ورحمة الله وبركاته .. أخي الكريم @عبده الطوخى 1970 ، في زر البحث وفي نهاية الكود ، فقط اضف السطر التالي [Forms]![Frm_Data_entry]![Frm_Fatura_Main].[Form]![Net_Teams] = [Forms]![Frm_Data_entry]![Frm_Fatura_Main].[Form]![Total_Main_Meter] - [Forms]![Frm_Data_entry]![Frm_Fatura_Sub].[Form]![Total_Sub_Meter] وشوف النتيجة اذا صحيحة أو لأ

مشاركة ، ولا اعلم ان كانت صحيحة تفضل الملف المعدّل baseM_9 .accdb

اخي العزيز @sm44ms ، انت ما شاء الله عضو مميز ، ولا بد لك من معرفة قوانين المنتدى بإرفاق ملف و الأهم هو العنواااان . ان يكون ذا صلة واضحة لنوع الاستفسار . على العموم جرب هذه الفكرة Private Sub KH_Click() ' إعادة تعيين جميع المربعات لتكون فارغة ClearAllLists ' تعبئة القوائم للنماذج المختلفة عند الضغط على KH Me.lstForms1.AddItem "شاشة اصدار البطاقات;FO1" Me.lstForms2.AddItem "شاشة تجديد البطاقات;FO2" Me.lstForms3.AddItem "شاشة تعديل بيانات البطاقات;FO3" Me.lstForms4.AddItem "شاشة تعديل بيانات اساسية فرعية;FO4" Me.lstForms5.AddItem "شاشة اصدار بطاقات المتقاعدين;FO5" Me.lstForms6.AddItem "شاشة البطاقات المنتهية;FO6" Me.lstForms7.AddItem "شاشة الملف الشخصي العام;FO7" End Sub Private Sub TW_Click() ' إعادة تعيين جميع المربعات لتكون فارغة ClearAllLists ' تعبئة القوائم للنماذج الخاصة بـ TW عند الضغط على TW Me.lstForms1.AddItem "شاشة الملف التاريخي العام;TW1" Me.lstForms2.AddItem "حركة الملفات التاريخية;TW2" Me.lstForms3.AddItem "الملف التاريخي;TW3" Me.lstForms4.AddItem "حالة المعاملات التاريخية;TW4" Me.lstForms5.AddItem "الشاشة قيد الاجراء;TW5" Me.lstForms6.AddItem "شاشة قيد الاجراء 2;TW6" Me.lstForms7.AddItem "شاشة الملف ;TW7" End Sub Private Sub ClearAllLists() ' إعادة تعيين جميع مربعات القوائم إلى الحالة الافتراضية Me.lstForms1.RowSource = "" Me.lstForms1.Value = Null Me.lstForms2.RowSource = "" Me.lstForms2.Value = Null Me.lstForms3.RowSource = "" Me.lstForms3.Value = Null Me.lstForms4.RowSource = "" Me.lstForms4.Value = Null Me.lstForms5.RowSource = "" Me.lstForms5.Value = Null Me.lstForms6.RowSource = "" Me.lstForms6.Value = Null Me.lstForms7.RowSource = "" Me.lstForms7.Value = Null End Sub Private Sub lstForms1_AfterUpdate() HandleFormOpen Me.lstForms1 End Sub Private Sub lstForms2_AfterUpdate() HandleFormOpen Me.lstForms2 End Sub Private Sub lstForms3_AfterUpdate() HandleFormOpen Me.lstForms3 End Sub Private Sub lstForms4_AfterUpdate() HandleFormOpen Me.lstForms4 End Sub Private Sub lstForms5_AfterUpdate() HandleFormOpen Me.lstForms5 End Sub Private Sub lstForms6_AfterUpdate() HandleFormOpen Me.lstForms6 End Sub Private Sub lstForms7_AfterUpdate() HandleFormOpen Me.lstForms7 End Sub Private Sub HandleFormOpen(lst As Control) ' تحقق من العنصر المحدد في مربع القائمة Dim selectedIndex As Integer selectedIndex = lst.ListIndex If selectedIndex = -1 Then MsgBox "يرجى اختيار عنصر من القائمة.", vbExclamation Exit Sub End If ' تحديد المفتاح الخاص بكل مجموعة من النماذج Dim prefix As String If Me.KH.Visible Then prefix = "FO" ' النموذج المختار من KH ElseIf Me.TW.Visible Then prefix = "TW" ' النموذج المختار من TW End If ' فتح النموذج بناءً على الفئة المختارة Select Case selectedIndex Case 0 OpenFormWithPrefix prefix & "1" Case 1 OpenFormWithPrefix prefix & "2" Case 2 OpenFormWithPrefix prefix & "3" Case 3 OpenFormWithPrefix prefix & "4" Case 4 OpenFormWithPrefix prefix & "5" Case Else MsgBox "النموذج غير موجود." End Select End Sub Private Sub OpenFormWithPrefix(formName As String) If Not IsFormOpen(formName) Then DoCmd.OpenForm formName End If End Sub Private Function IsFormOpen(formName As String) As Boolean ' التحقق إذا كان النموذج مفتوح بالفعل On Error Resume Next IsFormOpen = (CurrentProject.AllForms(formName).IsLoaded) On Error GoTo 0 End Function Private Sub Form_Load() ' إعادة تعيين مربعي القوائم عند فتح النموذج Me.lstForms1.RowSource = "" ' تفريغ مربع القائمة الأول Me.lstForms2.RowSource = "" Me.lstForms3.RowSource = "" Me.lstForms4.RowSource = "" Me.lstForms5.RowSource = "" Me.lstForms6.RowSource = "" Me.lstForms7.RowSource = "" End Sub ما تم هو إضافة منطق لفتح النماذج بناءً على الاختيارات المختلفة ، بالإضافة إلى تخصيص الفتح حسب المجموعة المختارة .

كان الأجدر بك أن تكون واضحاً في طلبك ، وأن يكون ملماً بكل الإحتمالات ، فلست انا من سيقرر الاحتمالات البديلة لكل حقل أكثر من 125 !!!!! شكراً لك

لو تعرف احكيلي علشان نلاقي حد يساعدنا

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