محمد أبوعبدالله

لعمل تصفية حسب الكمبوبوكس تفضل الكود التالي Dim myCriteria As String myCriteria = myCriteria & "(" myCriteria = myCriteria & "[IDED]= " & Me.cmbfind myCriteria = myCriteria & ")" Debug.Print myCriteria Me.Filter = myCriteria Me.FilterOn = True program.rar تحياتي

تفضل اخي الكريم تم التعديل ليتم التصفية من خلال الكود Dim myCriteria As String myCriteria = myCriteria & "(" myCriteria = myCriteria & "[Full_Name] Like '*" & Me.bb & "*'" myCriteria = myCriteria & ")" Debug.Print myCriteria Me.البحث.Form.Filter = myCriteria Me.البحث.Form.FilterOn = True test9.rar تحياتي

وما المشكلة ان يكون مربع تحرير وسرد انظر الى الكود التالي Private Sub XName_NotInList(NewData As String, Response As Integer) Dim ctl As Control Dim strSQL As String Set ctl = Me!XName If MsgBox(" الاسم " & " / " & _ Me.XName.Text & " / ليس ضمن القائمة هل تريد إضافته ", _ vbOKCancel, "officena") = vbOK Then Response = acDataErrAdded strSQL = "INSERT INTO a(الاسم) VALUES('" strSQL = strSQL & NewData & "');" CurrentDb.Execute strSQL MsgBox "تمت الاضافة ", , "officena" Else Response = acDataErrContinue ctl.Undo End If End Sub test7.rar تحياتي

مرحبا اخي الكريم تم اضافة المشروع من قبل وبالنسبة للاسم يمكن تنفيذ الكود التالي Me.FilterOn = False myCriteria = "" myCriteria = myCriteria & "(" myCriteria = myCriteria & "[BB].[pname]='" & Combo22.Column(1) & "'" myCriteria = myCriteria & ")" Me.Filter = myCriteria Me.FilterOn = True وهذا كود الطباعة حسب التصفية Debug.Print myCriteria DoCmd.OpenReport "BB", acViewPreview, , myCriteria وهذا الكود كامل Option Compare Database Dim myCriteria As String Private Sub Cmd01_Click() Debug.Print myCriteria DoCmd.OpenReport "BB", acViewPreview, , myCriteria End Sub Private Sub Combo19_Click() Me.FilterOn = False myCriteria = "" myCriteria = myCriteria & "(" myCriteria = myCriteria & "[BB].[code_proj]= " & Me.Combo19 myCriteria = myCriteria & ")" Me.Filter = myCriteria Me.FilterOn = True End Sub Private Sub Combo22_Click() Me.FilterOn = False myCriteria = "" myCriteria = myCriteria & "(" myCriteria = myCriteria & "[BB].[pname]='" & Combo22.Column(1) & "'" myCriteria = myCriteria & ")" Me.Filter = myCriteria Me.FilterOn = True End Sub APE12.rar تحياتي

تفضل اخي الكريم انظر النموذج frmBB وهذا كود التصفية Dim myCriteria As String myCriteria = myCriteria & "(" myCriteria = myCriteria & "[BB].[code_proj]= " & Me.Combo19 myCriteria = myCriteria & ")" Me.Filter = myCriteria Me.FilterOn = True APE1.rar تحياتي

السلام عليكم ارفق مثال بارك الله فيك ليتم التعديل عليه ان شاء الله تخياتي

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

وعليكم السلام ورحمة الله وبركاته تفضل اخي الكريم Like "*" & [forms]![EMPDEVMENU]![TXTFIND] & "*" program.rar تحياتي

اخي الكريم الحل هو هو ما ذكرته لك في اول مرة تقوم باضافة And وتضع معيار الحقل الثاني والثالث ... الخ If Not IsNull(Me.EmpName) Then If DCount("*", "data", "EmpName='" & Me.EmpName & "'" & "AND JobPlace='" & Me.JobPlace & "'") > 0 Then MsgBox "مكرر", vbInformation, "تحذير" Cancel = True Cm1_Click End I ملخص الفكرة انك تضع لكل حقل معيار وبين كل عملية تضع And وهكذا تحياتي

وعليكم السلام ورحمة الله وبركاته تفضل اخي الكريم Private Sub sv_Click() If Format(Time, "Long Time") >= #12:00:00 AM# And Format(Time, "Long Time") <= #3:00:00 AM# Then DoCmd.OpenForm "frm1" Else MsgBox "لا يمكن عمل دخول او خروج في الوقت الحالي" Exit Sub End If End Sub Private Sub أمر30_Click() If Format(Time, "Long Time") >= #12:00:00 AM# And Format(Time, "Long Time") <= #3:00:00 AM# Then DoCmd.OpenForm "frm2" Else MsgBox "لا يمكن عمل دخول او خروج في الوقت الحالي" Exit Sub End If End Sub test2.rar تحياتي

عذراً اخي الكريم لم افهمك من البداية لانك لم تشرح المطلوب بالضبط دعنا نعود للحل الاول الملف المرفق يتم فحص حقل EmpName اذا كان مكرر تظهر رسالة ويتم عرض المكرر في الليست بوكس يمكنك استكمال الباقي بنفس الطريقة Private Sub Cm1_Click() On Error GoTo ErrSub Dim StrWhere As String Dim StrSql As String If Not IsNull(Me.EmpName) Then StrWhere = StrWhere & " and [EmpName] like '*" & Me.EmpName & "*'" End If If Not IsNull(Me.JobPlace) Then StrWhere = StrWhere & " and [JobPlace] like '*" & Me.JobPlace & "*'" End If If Not IsNull(Me.Court) Then StrWhere = StrWhere & " and [Court] like '*" & Me.Court & "*'" End If If Not IsNull(Me.Statuse) Then StrWhere = StrWhere & " and [Statuse] like '*" & Me.Statuse & "*'" End If If Not IsNull(Me.ReportN) Then StrWhere = StrWhere & " and [ReportN] like '*" & Me.ReportN & "*'" End If If Not IsNull(Me.DevID) Then StrWhere = StrWhere & " and [DevID] like '*" & Me.DevID & "*'" End If If Not IsNull(Me.Code) Then StrWhere = StrWhere & " and [Code] like '*" & Me.Code & "*'" End If If Not IsNull(Me.DevType) Then StrWhere = StrWhere & " and [DevType] like '*" & Me.DevType & "*'" End If If Not IsNull(Me.SerialNum) Then StrWhere = StrWhere & " and [SerialNum] like '*" & Me.SerialNum & "*'" End If If Not IsNull(Me.Company) Then StrWhere = StrWhere & " and [Company] like '*" & Me.Company & "*'" End If 'ازالة كلمة And من يسار جملة التصفية StrWhere = Right(StrWhere, Len(StrWhere) - 5) ' اختيار مصدر السجلات للنموذج الفرعي و تطبيق عامل التصفية StrSql = "SELECT * FROM data where " & StrWhere Debug.Print StrSql Me.SearchList.RowSource = StrSql ErrSub: If Err.Number <> 0 Then MsgBox Err.Number & vbCrLf & Err.Description, vbCritical + vbMsgBoxRight End If End Sub Private Sub Form_Load() DoCmd.GoToRecord , , acNewRec End Sub Private Sub EmpName_BeforeUpdate(Cancel As Integer) If Not IsNull(Me.EmpName) Then If DCount("*", "data", "EmpName='" & Me.EmpName & "'") > 0 Then MsgBox "مكرر", vbInformation, "تحذير" Cancel = True Cm1_Click End If End If End Sub Up-البحث في جميع الحقول للحصول على السجلات المكرره.rar تحياتي

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

ممكن في النماذج والتقارير عن طريق التنسيق الشرطي تحياتي

تفضل اخي الكريم DoCmd.SetWarnings False DoCmd.RunSQL "UPDATE header_m_item_link SET header_m_item_link.s_cost_price1 = [FORMS]![all_links_items]![s_cost_price1] WHERE (((header_m_item_link.m_item_id)=[FORMS]![all_links_items]![m_item_id]));" DoCmd.SetWarnings True new4.0.rar تحياتي

وعليكم السلام ورحمة الله وبركاته تفضل اخي الكريم لتغيير ايقونة النماذج والتقارير CurrentDb.Properties("AppIcon") = "D:\N.ico" ولتغيير ايقونة سطح المكتب لا بد اولا من انشاء اختصار على سطح المكتب للبرنامج وهذه وظيفة الكود التالي Dim WshShell As Object Set WshShell = CreateObject("WScript.Shell") Dim strDesktop As String strDesktop = WshShell.SpecialFolders("Desktop") Dim X As Object Set X = WshShell.CreateShortcut(strDesktop & "\Officena.lnk") X.TargetPath = CurrentProject.Path & "\" & CurrentProject.Name X.WindowStyle = 1 X.IconLocation = CurrentProject.Path & "\N.Ico" X.Description = "Officena" X.WorkingDirectory = strDesktop X.Save تحياتي

اعتقد اخي ازهر السؤال الصحيح هو متى نسنخدم متغير من نوع Variant تحياتي

وعليكم السلام ورحمة الله وبركاته تفضل اخي الكريم Private Sub أمر11_Click() Dim rs As Object Set rs = Me.Recordset.Clone rs.FindFirst "[no_m]=""" & Me.نص9 & """" Me.Bookmark = rs.Bookmark End Sub Private Sub أمر13_Click() Dim rs As Object Set rs = Me.Recordset.Clone rs.FindFirst "[name]=""" & Me.نص12 & """" Me.Bookmark = rs.Bookmark End Sub تجريبي1.rar تحياتي

تفضل اخي الكريم البحث في جميع الحقول للحصول على السجلات المكرره.rar تحياتي

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

يعمل 100% تحياتي

وانت بالف خير اخي الكريم موفق باذن الله

الكود يعمل معك في السجلات الجديدة حيث انه القيمة الافتراضية للحقل اما السجلات السابقة التي لم يكون موجود بها قيمة افتراضية فلن يظهر ولجعل قيمة هذا الحقل تأخذ تاريخ اليوم او اي تاريخ تريد عليك بانشاء استعلام تحديث كالتالي UPDATE العملاء SET العملاء.[تاريخ اخر قسط متاخر] = Date(); تحياتي

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