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

سيدي الفاضل ابو عبدالله عندك مشكلتين: 1. في الاستعلام usys_account ، عندك كلمة usys مكررة مرتين ، وهذا خطأ مطبعي ، 2. ولكن المشكلة الاكبر والتي لا يعرفها الكثير من المبرمجين ، وهو عدم استعمال علامة "ناقص" في مسميات كائنات الاكسس (لاحظ اسم الجدول usys-invoicesale ) ، واذا اردت استعمالها كلٌ ولابد ، فيجب ان تضع هذا المسمى بين قوسين مربعين في الكود ، هكذا: [usys-invoicesale] جعفر

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

وعليكم السلام بما انك عملت تغيير في الكود الاصل ، واللي كان تابع لحدث "قبل التحديث" الحقول ، فيجب ان نُرجع الكود ، بحيث انه يخاطب كود "قبل تحديث النموذج" ، وبدل ان اضيف الكود لكل حقل ، اعمل التالي: اختار الحقول التي يجب على البرنامج يتأكد منها (كما في الصورة ادناه) ، ثم في الحدث "قبل التحديث" لهذه الحقول ، ننادي الوحدة النمطية chk_BeforeUpdate (رجاء كتابة اسم الوحدة النمطية كما تراها في الصورة ادناه) ، هكذا : . وعليه ، فيجب علينا إضافة الوحدة النمطية الجديدة ، وعمل تعديل بسيط على الكود الاصل ، ليصبحا هكذا : Function chk_BeforeUpdate() Call Form_BeforeUpdate(0) End Function Private Sub Form_BeforeUpdate(Cancel As Integer) On Error GoTo err_chk_BeforeUpdate Dim ctl As Control Dim rst As DAO.Recordset Dim dbs As DAO.Database Dim fName As String: Dim myCriteria As String Dim A0 As String: Dim A1 As String: Dim A2 As String If Left(Me.ActiveControl.Name, Len("TextBox")) <> "Textbox" Then Set ctl = Me.ActiveControl Else Set ctl = ctlDrop End If fName = "[" & Mid(ctl.Name, 1, Len(ctl.Name) - 1) & "-مادة" & Right(ctl.Name, 1) & "]" '[الاثنين-مادة1] myCriteria = "[" & ctl.Name & "]=" & Chr(39) & ctl.Value & Chr(39) 'A0 = DLookup(ctl.Name, "Teacher Class", myCriteria) 'A1 = DLookup(fName, "Teacher Class", myCriteria) 'A2 = DLookup("[NAMEe]", "Teacher Class", myCriteria) Set dbs = CurrentDb Set rst = dbs.OpenRecordset("Select * From [Teacher Class] Where " & myCriteria) A0 = rst(ctl.Name) A1 = rst(fName) A2 = rst!NAMEe ' If A0 > 0 Then Beep If MsgBox("...هذا الفصل " & ctl.Name & "..لديه مادة.." & vbCrLf & _ " باسم : " & A1 & vbCrLf & _ " للمدرس : " & A2, _ vbYesNo + vbCritical + vbMsgBoxRight, "تنبيه") = vbNo Then Me.Undo Cancel = True End If ' End If Exit_chk_BeforeUpdate: rst.Close: Set rst = Nothing: dbs.Close Exit Sub err_chk_BeforeUpdate: If err.Number = 3021 Then Resume Next Else MsgBox err.Number & vbCrLf & err.Description End If End Sub . اما بالنسبة الى رسائل الخطأ التي تكلمت عنها ، فلا علم لي بها , ولم تظهر لي. جعفر جدول الحصص.zip

تم التعديل Option Explicit Sub Salim_Index() Application.ScreenUpdating = False Dim S_sh As Worksheet: Set S_sh = Sheets("الدرجات") Dim Index_sh As Worksheet: Set Index_sh = Sheets("قائمة") If ActiveSheet.Name <> Index_sh.Name Then GoTo Leave_Me_Out Dim my_st1$, my_st2$, my_st3$ Dim lr%: lr = S_sh.Cells(Rows.Count, 1).End(3).Row Dim Flt_Rg As Range: Set Flt_Rg = S_sh.Range("a4:R" & lr) Index_sh.Range("b5:c150").ClearContents my_st1 = "=" & Index_sh.[j1] my_st2 = "=" & Index_sh.[j2] my_st3 = Replace(Index_sh.[j3], "*", "") my_st3 = "*" & my_st3 & "*" Flt_Rg.AutoFilter Field:=13, Criteria1:=my_st1 Flt_Rg.AutoFilter Field:=4, Criteria1:=my_st2 Flt_Rg.AutoFilter Field:=15, Criteria1:= _ "=" & my_st3, Operator:=xlAnd '=========================== Flt_Rg.Columns(2).SpecialCells(xlCellTypeVisible).Copy Index_sh.Range("b4").PasteSpecial Paste:=xlPasteValues Flt_Rg.Columns(3).SpecialCells(xlCellTypeVisible).Copy Index_sh.Range("c4").PasteSpecial Paste:=xlPasteValues Application.CutCopyMode = False Flt_Rg.AutoFilter Leave_Me_Out: Application.ScreenUpdating = True End Sub الملف filter by 3 Criterias_Modifier.xlsm

مخزن سيد.rar

جرب هذا الماكرو Option Explicit Sub Salim_Index() Application.ScreenUpdating = False Dim S_sh As Worksheet: Set S_sh = Sheets("الدرجات") Dim Index_sh As Worksheet: Set Index_sh = Sheets("قائمة") If ActiveSheet.Name <> Index_sh.Name Then GoTo Leave_Me_Out Dim my_st1$, my_st2$, my_st3$ Dim lr%: lr = S_sh.Cells(Rows.Count, 1).End(3).Row Dim Flt_Rg As Range: Set Flt_Rg = S_sh.Range("a4:R" & lr) Index_sh.Range("b5:c150").ClearContents my_st1 = "=" & Index_sh.[j1] my_st2 = "=" & Index_sh.[j2] my_st3 = "=" & Index_sh.[j3] Flt_Rg.AutoFilter Field:=13, Criteria1:=my_st1 Flt_Rg.AutoFilter Field:=4, Criteria1:=my_st2 Flt_Rg.AutoFilter Field:=15, Criteria1:=my_st3 Flt_Rg.Columns(2).SpecialCells(xlCellTypeVisible).Copy Index_sh.Range("b4").PasteSpecial Paste:=xlPasteValues Flt_Rg.Columns(3).SpecialCells(xlCellTypeVisible).Copy Index_sh.Range("c4").PasteSpecial Paste:=xlPasteValues Application.CutCopyMode = False Flt_Rg.AutoFilter Leave_Me_Out: Application.ScreenUpdating = True End Sub الملف مرفق filter by 3 Criterias.xlsm

تفضل شرح المعادلة.docx

تقبل تحياتى-تفضل sampel-1.xlsx

تفضل تم التعديل الشرح : 1- جميع الحقول في الجدول جعلت الخاصية مطلوب=نعم 2- اضفت دالة تجدها في محرر النموذج تمنع ترك اي حقل فارغ تأكيد2 .rar

ارفع ملفاً نموذجاً (حوالي 20 اسم) مع المعلومات المطلوية بجدول وسنحاول المساعدة

وعليكم السلام اخوي حمدي ادخل في اكواد VBA عن طريق: Ctrl+G او Alt+F11 ، ثم : 1. اضغط على F1 من الكيبورد ، بيظهر لك مساعد الاكسس: 2. اكتب msgbox للبحث عن هذا الامر ، 3. ستجد شرح كامل عن جميع مكونات هذا الامر ، والاوامر التي تستطيع استعمالها فيه ، 4. بالاضافة الى وجود مثال جاهز تستطيع ان تأخذ نسخه منه ، وتغيره حسب حاجتك جعفر