jjafferr

التاريخ يخلق مشكلة في الكثير من الاحيان ، وبعض الاحيان بسبب اعدادات الكمبيوتر ، لهذا السبب انا عملت هذا الرابط . وبإستخدام الوحدة النمطية الموجودة في الرابط اعلاه والتي تهتم بالتاريخ ، اصبح الكود هكذا: Private Sub بحث_Click() On Error Resume Next Dim ctl As Control Dim Argcount As Integer Dim str As String Argcount = 0 MyCriteria = "" For Each ctl In Me.Controls If (ctl.ControlType = acTextBox Or ctl.ControlType = acComboBox Or ctl.ControlType = acCheckBox) And ctl.Tag <> "" Then If ctl.Name <> "Date_From" And ctl.Name <> "Date_To" Then AddToWhere ctl.Tag, ctl.Value, "[" & ctl.Name & "]", MyCriteria, Argcount End If End If Next ctl If Len(Me.Date_From & "") <> 0 And Len(Me.Date_To & "") <> 0 Then If Len(MyCriteria & "") <> 0 Then MyCriteria = MyCriteria & " And " End If 'MyCriteria = MyCriteria & " [Date_BR] between #" & Me.Date_From & "# And #" & Me.Date_To & "#" MyCriteria = MyCriteria & " [Date_BR] between " & DateFormat(Me.Date_From) & " And " & DateFormat(Me.Date_To) End If 'Debug.Print MyCriteria myStr = "select * from S_NAMES where " & MyCriteria Me.S_NAME.Form.RecordSource = myStr Me.Requery End Sub جعفر

الظاهر هكذا !! بس لوسمحتي تأخذين صورة للشاشة وارسليها ، يمكن اعدادات تنسيق التاريخ عندك نظام امريكي ، يعني الشهر / اليوم / السنة ، والمشكلة هاي ما تبين إلا في التواريخ الاكبر من 12 !! ولكن ومثل ما تفضلتي ، غيري تنسيق التاريخ في جهازك واخبريني التجربة. ولكن ، رجاء تجربي هذا المرفق اولا وقبل تغيير اي شئ جعفر 566.1.Employees.mdb.zip

ارفق لكي نفس البرنامج مرة اخرى ، كل شئ عندي تمام . جعفر 566.Employees.mdb.zip

الحمدلله ، انا وابوخليل ورمهان (هذيل اللي عرفتهم) موجودين في المشاركة شكرا اخي شفان جعفر

السلام عليكم أخي كريمو امر فتح التقرير عندك لازم يكون هكذا Dim stDocName As String stLinkCriteria = "EmployeeID=" & Me.EmployeeID stDocName = "x03" 'DoCmd.OpenReport stDocName, acPreview DoCmd.OpenForm "PrintPreviewFrm", , , , , acDialog, stDocName & ";" & Me.Name . انت لا تفتح التقرير ، وانما تفتح النموذج PrintPreviewFrm ، وترسل اليه اسم التقرير واسم النموذج الذي به زر فتح التقرير ، والنموذج PrintPreviewFrm هو الذي يقوم بفتح التقرير جعفر

أختي الظاهر انك بحثتي بالتاريخ فقط!! على العموم ، هذا الكود المعدل يعمل للبحثين معا ، او اي بحث مستقل (الحقول او التاريخ): Private Sub بحث_Click() On Error Resume Next Dim ctl As Control Dim Argcount As Integer Dim str As String Argcount = 0 MyCriteria = "" For Each ctl In Me.Controls If (ctl.ControlType = acTextBox Or ctl.ControlType = acComboBox Or ctl.ControlType = acCheckBox) And ctl.Tag <> "" Then If ctl.Name <> "Date_From" And ctl.Name <> "Date_To" Then AddToWhere ctl.Tag, ctl.Value, "[" & ctl.Name & "]", MyCriteria, Argcount End If End If Next ctl If Len(Me.Date_From & "") <> 0 And Len(Me.Date_To & "") <> 0 Then If Len(MyCriteria & "") <> 0 Then MyCriteria = MyCriteria & " And " End If MyCriteria = MyCriteria & " [Date_BR] between #" & Me.Date_From & "# And #" & Me.Date_To & "#" End If 'Debug.Print MyCriteria myStr = "select * from S_NAMES where " & MyCriteria Me.S_NAME.Form.RecordSource = myStr Me.Requery End Sub جعفر 566.Employees.mdb.zip

السلام عليكم اخي أبونادر البحث السابق كان لجميع الحقول ، والبحث الجديد يجب ان يكون لجميع الحقول و بين التاريخين ، والظاهر انك نسيت البحث في الحقول ، وعملت البحث بين تاريخين فقط جعفر

وعليكم السلام اختي كود البحث اصبح: Private Sub بحث_Click() On Error Resume Next Dim ctl As Control Dim Argcount As Integer Dim str As String Argcount = 0 MyCriteria = "" For Each ctl In Me.Controls If (ctl.ControlType = acTextBox Or ctl.ControlType = acComboBox Or ctl.ControlType = acCheckBox) And ctl.Tag <> "" Then If ctl.Name <> "Date_From" And ctl.Name <> "Date_To" Then AddToWhere ctl.Tag, ctl.Value, "[" & ctl.Name & "]", MyCriteria, Argcount End If End If Next ctl If Len(Me.Date_From & "") <> 0 And Len(Me.Date_To & "") <> 0 Then MyCriteria = MyCriteria & " And [Date_BR] between #" & Me.Date_From & "# And #" & Me.Date_To & "#" End If 'Debug.Print MyCriteria myStr = "select * from S_NAMES where " & MyCriteria Me.S_NAME.Form.RecordSource = myStr Me.Requery End Sub . جعفر 566.Employees.mdb.zip

وعليكم السلام هناك عدة اسباب: منها: iif ، وحسب الدرس التالي: عيوبها: الدالة تختبر جميع الحالات ، ولا تختبر القيمة الاولى وتخرج (مثل الـ IF) وارى هنا انك تستعمل iif ستة مرات ، ولثلاثة حقول: . وهذا سبب آخر: . وفهرست الحقول في الجدول ، تلك التي تستخدمها كمعيار في الاستعلام ، وانت عندك الكثير منها في المثال اعلاه. وطبعا يكون في العديد من الاسباب الاخرى ، ونستطيع معرفتها بفحص البرنامج بدقة جعفر

تفضل: ولكني لا انصح بهذه الطريقة ، فالطريقة السابقة (استعمال استعلامين) جدا مرنه ، بينما يجب تغيير قيم DoctorCode و VisitDate في كل حقل بطريقة يدوية (إلا اذا كنت تأخذ هذ المتغيرات من نموذج مفتوح او جدول) . والنتيجة . جعفر 565.1.mdb.zip

وهذه نتائجي ، مطابقة: الاستعلام القديم والجديد . ونتائجهم . جعفر 565.1.mdb.zip

علشان نقدر نقرأ المعادلة ، ففكتها لمعرفة اماكن الحقول الى: A1 = "[امتار الإنتاج]" A2 = "امر التشغيل" A3 = "لوحة تحكم" A4 = "تاريخ الصب" A5 = "المنتج" A6 = "نوع" Me.n1 = DSum("[A1]", "A2", "[A6]=[FORMS]![A3]![M] AND [A5]=[FORMS]![A3]![B2] AND [A4]=[FORMS]![A3]![MM]") . وانا استغرب اذا كانت المعادلة تشتغل اصلا ، لأن طريقتها غير صحيحة!! الآن السوال: الحقول M و B2 و MM اي منها نص ، واي منها رقم ؟ جعفر

تفضل جعفر

السلام عليكم هذا مثال متوسع على الدالة NZ جعفر

وعليكم السلام تفضل: برنامج جاهز: http://www.peterssoftware.com/isd.htm وكود من https://www.experts-exchange.com/questions/28397475/Shutdown-Access-Database-After-Certain-Idle-Time.html Private Sub Form_Load() ' start the count down in 3 minutes (60 x 3 = 180) Me.Tag = 180 ' interval is every second Me.TimerInterval = 1000 End Sub Private Sub Form_Timer() On Error Resume Next '********************************** ' Bail out when count down is zero '********************************** Me.Tag = Val(Me.Tag) - (Me.TimerInterval / 1000) Me.Caption = "Form will exit in " & Me.Tag & " seconds" If Val(Me.Tag) <= 0 Then DoCmd.Quit End If End Sub . جعفر

وعليكم السلام جرب len([coodkindexchange] & '')=0 وفي VBA len([coodkindexchange] & "")=0 هذا يعمل عمل السطرين isnull([coodkindexchange])= true و [coodkindexchange]= "" جعفر والاسهل هو فك الشروط الى اسطر سهل التعامل معاها C = "[exchange]>0" C = C & " And len([coodkindexchange] & '')=0" C = C & " And [Yaree] =" & Forms![frm_3]![Yaree] C = C & " and [Monthly] =" & Forms![frm_3]![Monthly] If DCount("[coodkind]", "Tbl_Month", C) > 0 Then بحيث تستطيع ان توقف عمل اي سطر بعمل اشارة ' (او rem) اما السطر/الاسطر التي لا تريدها في الشرط) جعفر

وعليكم السلام تفضل: Private Sub Form_ApplyFilter(Cancel As Integer, ApplyType As Integer) Dim rst As DAO.Recordset ApplyType = acShowAllRecords If Len(Me.Filter & "") = 0 Then mySQL = "Select * From " & Me.RecordSource Else mySQL = "Select * From " & Me.RecordSource & " Where " & Me.Filter End If Set rst = CurrentDb.OpenRecordset(mySQL) rst.MoveLast: rst.MoveFirst RC = rst.RecordCount Me.Engineers = 0 Me.Teachers = 0 For i = 1 To RC If rst!job = "ãåäÏÓ" Then Me.Engineers = Me.Engineers + 1 ElseIf rst!job = "ÇÓÊÇÐ" Then Me.Teachers = Me.Teachers + 1 End If rst.MoveNext Next i End Sub Private Sub Form_Current() Call Form_ApplyFilter(0, 0) End Sub Private Sub Form_Load() Me.Filter = "" Me.FilterOn = False Call Form_ApplyFilter(0, 0) End Sub . جعفر 564.db.accdb.zip

وعليكم السلام اختي جربي هذا المرفق ، والذي ينتظر ثانيتين بعد ان يعمل الاستعلام qry_Temp ، اذا ما اشتغل ، فلازم نمشي في الكود سطر بسطر ، ونعرف وين المشكلة. جعفر 563.الموظفين.mdb.zip

تفضلي 563.الموظفين.mdb.zip

لأني كسلان اذا اردت استعمالها ، فيجب ان يتغير الكود الى: Option Compare Database Option explicit Function Seperate_Digits(T as string) as string dim i as integer dim C as string dim Which_Letter as string 'T = Text From Query If Len(T & "") = 0 Then Seperate_Digits = "" Exit Function End If For i = 1 To Len(T) 'the ascii number of each number C = Asc(Mid(T, i, 1)) 'ascii numbers we want '46= . '47= / '48= 0 '49= 1 '50= 2 '51= 3 '52= 4 '53= 5 '54= 6 '55= 7 '56= 8 '57= 9 Select Case C Case 46, 48 To 57 Which_Letter = Which_Letter & Mid(T, i, 1) Case 47 Which_Letter = "" End Select Next i Seperate_Digits = Which_Letter End Function جعفر جعفر

وعليكم السلام تفضلي ، التصدير الى اكسل وورد: Private Sub TOEX_Click() On Error GoTo err_TOEX_Click 'delete qry_Temp DoCmd.DeleteObject acQuery, "qry_Temp" 'make the new qry_Temp Set qrydf = CurrentDb.CreateQueryDef("qry_Temp", Me.S_NAME.Form.RecordSource) 'Export to xls 'File_Name= "C:\ASD\ASD.xlsx" File_Name = Application.CurrentProject.Path & "\myExcel.xls" 'DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9, "qry_Temp", File_Name, True DoCmd.OutputTo acOutputQuery, "qry_Temp", acFormatXLS, File_Name, True 'Export to Word File_Name = Application.CurrentProject.Path & "\myWord.rtf" DoCmd.OutputTo acOutputQuery, "qry_Temp", acFormatRTF, File_Name, True CurrentDb.QueryDefs.Delete qrydf.Name 'cleanup Set qrydf = Nothing Exit Sub err_TOEX_Click: If Err.Number = 7874 Then 'qry_Temp does not exist Resume Next Else MsgBox Err.Number & vbCrLf & Err.Description End If End Sub جعفر