jjafferr

وعليكم السلام تفضل: 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 جعفر

تفضل ، هذه الوحدة النمطية الجديدة 1. نحسب طول المعلومة ، اذا كانت صفر ، فلا ندخل في بقية المعادلات ، 2. واذا لقينا Case 47 ، فنحذف كل ما كان قبله ""=Which_Letter ، ونبدأ البحث عن الارقام من جديد Function Seperate_Digits(T) '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 جعفر

لوسمحت تشرح اللي تريده ، لأني ما فهمت جعفر

السلام عليكم اسمحوا لي ان اطلب منكم هذا الطلب: هذا الصرح/المنتدى تعليمي ، ولا يختص بصاحب السؤال/الموضوع ، فرجاء ممن يعطي الاجابة ، ان يشرح الطريقة حتى يستفيد الجميع المرفق يستفيد منه صاحب السؤال ، ولكن شرح المحترف/الخبير يستفيد منه كل من يقرأ الموضوع تصوروا المنتدى بدون اي شرح وتوضيح ، وفقط مرفق!! شكرا جعفر

السلام عليكم أستاذ علي معلش اتحملني شوي ، الطلب ليس متكامل اولا انا نسيت ايش بالضبط اللي لازم يصير (العتب على الشيب) ، ولكني عملت تغيير في الخطة ، وان شاء الله يكون مناسب للنوعين من التقارير اختر تاريخين من النموذج frm_PrintRpt ، للإختيار الاول "بين تاريخين محددين" . 1. لما تضغط على زر عمل التقرير ، البرنامج يعمل جدول خارجي ، به التواريخ والايام و eSIS جميع الطلبة للصف والشعبة ، هذا الجدول المؤقت (tmp_tbl_Dates_Days) في البرنامج المؤقت (tmp_Dates_Days.mdb) يتكون في مجلد الوندوز Temp ، ولست بحاجة لرؤيته ، وعندما يتكون الجدول ، ترى نتائجه في الاستعلام qry_Temp ، 2. تلقائيا الاستعلام qry_T2 يفتح ، وسترى فيه جميع الايام ، سواء بغياب او بدون ، ويجب ان نعدل الحقول في هذا الاستعلام ، ونعمل التقريرين منه رجاء فحص هذا العمل ، لأنه سيستبدل العمل السابق ، ولكني بحاجة الى توجيهك للخطوة التالية اما الاختيار الثاني "طباعة التقرير بالكامل" فيقوم الكود بأخذ اول يوم في الجدول ، وآخر يوم ، ويقوم بنفس العملية اعلاه الاستعلامات الوحيدة التي اعتمدت عليها في هذه الخطوة هي qry_T1 و qry_T2 و qry_Temp ، والشغل كله تقوم به الوحدة النمطية التالية: Option Compare Database Dim tbdf As TableDef, qrydf As QueryDef, fld As Field Dim rst As DAO.Recordset, rst_TQ As DAO.Recordset Dim sfrm As Form Dim wrkAcc As Workspace Dim dbsNew As Database Dim mdb_Name As String Public H1 As Integer Function Make_DB() On Error GoTo err_Make_DB 'populate Arabic day in an array Dim Arabic_Days() As String Set rst = CurrentDb.OpenRecordset("Select * From tbl_Months") rst.MoveLast: rst.MoveFirst ReDim Arabic_Days(7) For i = 1 To 7 Arabic_Days(i) = rst!Day_A rst.MoveNext Next i 'How Many Students mySQL = "SELECT Grade, Section, eSIS FROM tbl_Follow4" mySQL = mySQL & " Where Grade='" & [Forms]![frm_PrintRpt]![StuGrade] & "'" mySQL = mySQL & " AND Section='" & [Forms]![frm_PrintRpt]![StuSection] & "'" mySQL = mySQL & " GROUP BY Grade, Section, eSIS" 'Debug.Print mySQL Set rst_TQ = CurrentDb.OpenRecordset(mySQL) rst_TQ.MoveLast: rst_TQ.MoveFirst How_Many_Students = rst_TQ.RecordCount 'create an empty Dates_Days.mdb in the same folder as the FE 'this will allow more than one user to use This DB Set wrkAcc = CreateWorkspace("AccessWorkspace", "admin", "", dbUseJet) 'database name and path (in the Windows Temp Folder) mdb_Name = GetWinTemp & "\tmp_Dates_Days.mdb" 'mdb_Name = Application.CurrentProject.Path & "\tmp_Dates_Days.mdb" ' Make sure there isn't already a file with the name of the new database. If Dir(mdb_Name) <> "" Then Kill mdb_Name ' Create the new database Set dbsNew = wrkAcc.CreateDatabase(mdb_Name, dbLangGeneral) dbsNew.Close wrkAcc.Close 'make a Table tmp_tbl_Dates_Days using "Make Table" query in the DB Dates_Days.mdb mySQL = "SELECT tmp_tbl_Dates_Days.* INTO tmp_tbl_Dates_Days IN " & Chr(34) & mdb_Name & Chr(34) mySQL = mySQL & " FROM tmp_tbl_Dates_Days" 'Debug.Print mySQL DoCmd.SetWarnings False DoCmd.RunSQL mySQL DoCmd.SetWarnings True 'set the Dates required If Forms!frm_PrintRpt!MyDates = 1 Then fDate = Forms!frm_PrintRpt!FromDate tDate = Forms!frm_PrintRpt!ToDate Else fDate = DMin("[DayDate]", "tbl_Follow4") tDate = DMax("[DayDate]", "tbl_Follow4") End If Set dbsNew = OpenDatabase(mdb_Name) Set rst = dbsNew.OpenRecordset("Select * From tmp_tbl_Dates_Days") For j = 1 To How_Many_Students N = fDate dif = DateDiff("d", fDate, tDate) For i = 0 To dif N = DateAdd("d", i, fDate) 'MsgBox "Date:" & N & vbCrLf & "Day :" & Format(N, "dddd") 'skip Fridays and Saturdays If Weekday(N) <> 6 And Weekday(N) <> 7 Then rst.AddNew rst!DayDate = N rst!DayName = Arabic_Days(Weekday(N)) 'Format(N, "dddd") rst!eSIS = rst_TQ!eSIS rst.Update 'MsgBox Arabic_Days(Weekday(N)) & vbCrLf & Format(N, "dddd") End If Next i rst_TQ.MoveNext Next j 'now make the query qry_Temp based on the new location mySQL = "SELECT Auto_ID, DayDate, DayName, eSiS" mySQL = mySQL & " FROM tmp_tbl_Dates_Days IN " & Chr(34) & mdb_Name & Chr(34) mySQL = mySQL & " ORDER BY Auto_ID" 'delete the old qry_Temp DoCmd.DeleteObject acQuery, "qry_Temp" 'make the new qry_Temp Set qrydf = CurrentDb.CreateQueryDef("qry_Temp", mySQL) rst.Close: Set rst = Nothing rst_TQ.Close: Set rst_TQ = Nothing dbsNew.Close Exit Function err_Make_DB: If Err.Number = 3270 Then 'this field does not have a caption for it, give it the field name ElseIf Err.Number = 3024 Or Err.Number = 91 Or Err.Number = 52 Or Err.Number = 53 Or Err.Number = 3055 Then 'mdb, and Table not found to Delete Resume Next ElseIf Err.Number = 3167 Then 'ignor, Records Deleted Resume Next Else MsgBox Err.Number & vbCrLf & Err.Description End If End Function جعفر 459.2.AbsentLate-10-12-2016.accdb.zip

وعليكم السلام عملت وحدة نمطية لحل الموضوع: . والنتيجة . والوحدة النمطية: Function Seperate_Digits(T) 'T = Text From Query 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 To 57 Which_Letter = Which_Letter & Mid(T, i, 1) End Select Next i Seperate_Digits = Which_Letter End Function . جعفر 562.ExtractNumbers.accdb.zip

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

حيا الله اخوي رمهان وينك يا رجال ، طوّلت الغيبة سبحان الله ، نفس الفكرة ، ولكن كالعادة انت بطريقة مختصرة شئ واحد ناقص في الكود عندك وهو عدد الرجال وعدد النساء جعفر

السلام عليكم اعمل حقل في النموذج باسم v لرقم القرية ، ثم استخدم هذا الكود: Private Sub fcount_AfterUpdate() Call result Call Make_SQL End Sub Private Sub mcount_AfterUpdate() Call result Call Make_SQL End Sub Function Make_SQL() m_SQL = "SELECT TOP " & Me.mcount & " ibv, [name#], gender, v " m_SQL = m_SQL & "FROM nregistration " m_SQL = m_SQL & "WHERE gender = 'male' And v ='" & Me.v & "'" 'm_SQL = m_SQL & " ORDER BY [name#], gender" 'Debug.Print m_SQL f_SQL = "SELECT TOP " & Me.fcount & " ibv, [name#], gender, v " f_SQL = f_SQL & "FROM nregistration " f_SQL = f_SQL & "WHERE gender = 'Female' And v ='" & Me.v & "'" f_SQL = f_SQL & " ORDER BY gender Desc, [name#]" 'male First 'f_SQL = f_SQL & " ORDER BY gender, [name#]" 'Female First 'Debug.Print f_SQL u_SQL = m_SQL & vbCrLf & "Union All" & vbCrLf & f_SQL 'Debug.Print u_SQL Me.join.Form.RecordSource = u_SQL End Function . هذا عبارة عن 3 استعلامات ، استعلام للرجال ، وثاني للنساء ، وثالث يجمعهم (استعلام توحيد Union Query) ، وفرز النساء يأتي اولا بسبب ان الجنس موجود بطريقة تصاعديه ، فاذا اردت ان تجعل الرجال اولا، فغير بين هذين السطرين: f_SQL = f_SQL & " ORDER BY gender Desc, [name#]" 'male First 'f_SQL = f_SQL & " ORDER BY gender, [name#]" 'Female First جعفر 560.filter.accdb.zip

الافضل في هذه الحالة ان تكون عندك مجموعة اعمدة جاهزة في تقرير ، ثم تعمل لك نموذج فيه اسماء الاعمدة/الحقول اللي في التقرير ، وتضع علامة علامة نعم/لا لكل حقل تريده في التقرير ، وعلى هذا الاساس ، ينطبع التقرير من الاكسس بمزاجهم ويمكن ارسال البيانات الى الوورد بعدة طرق ، منها ما شرحته هنا: http://arabteam2000-forum.com/index.php?/topic/280527-تنسيق-تقرير-أكسيس-مثل-تنسيق-ملف-وورد/&do=findComment&comment=1351657 جعفر

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

على اي سطر من الكود؟

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

الآن سؤالك اصبح غير واضح!! رجاء شرح ما تريد وبالتفصيل ، وابدء باسم النموذج واسم الحقل واسم الجدول ن ثم ماذا يجب ان نرى ، وماذا تريد ان يصير انت صاحب البرنامج وادرى به منا جعفر

تفضل هذا مثال ، وانت ضبطه على برنامجك for JPG files Shell ("cmd /c mspaint /p " & "D:\test.jpg") for PDF files Shell ("C:\Program Files\Adobe\Acrobat Reader DC\Reader\AcroRd32.exe /p /h " & "D:\Sheet.pdf") جعفر

وعليكم السلام تفضل (طبعا غير معروف عندنا المعايير بالضبط ، فهناك احتمال محتاج تغيير حسب المعايير) task1 = "select top " & strmcount & " * from nregistration where " & strtotal1 & " And " & strtotal2 جعفر

وعليكم السلام اهلا وسهلا بك في المنتدى قواعد المشاركة فى الموقع اضغط هنـــــــــامن فضلك لقراءة القواعد كاملة و بصفة خاصة نؤكدعلى ما يلي 1- يمنع منعا باتا نشر أية مواد تخالف حقوق الملكية الفكرية و يرجى الابلاغ عن المشاركات المخالفة من خلال زر تقرير اسفل المشاركة 2-يجب استخدام خاصيةالبحث قبل طرح السؤال توفيرا للوقت و الجهد. 3-ضرورة كتابة عنوان واضح للموضوع يدل على محتواه ويعطي وصفاً مختصرا للسؤال. 4-ممنوع منعا باتاً كتابة عناوين سينمائية مثل عاجل ، نداء الي فلان ، الي الخبراء ، طلب مساعدة ، أريد حلا..... 5-يمكن استعجال الرد باستخدام تعبير -للرفع- و غير مسموح بالالحاح او اللوم فجميع الاعضاء يشاركون تطوعا طبقا لسعة وقتهم. ومخالفة ذلك تعرض الموضوع للحذف رجاء فتح موضوع جديد بعنوان واضح مخالف - يُقفل جعفر

اختي طلبك غير واضح ، رجاء اعطينا مثال جعفر

او تغيير اعدادات الوندوز: جعفر

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