jjafferr

وعليكم السلام 🙂 1. هل كان البرنامج يعمل وفجأة توقف ؟ 2. ارفق رسالة الخطأ . جعفر

على العموم ، هذا البرنامج الكامل ، مع التعديلات اللي اعطيتك اعلاه 🙂 جعفر FMARK.zip

رجاء عمل نسخة من برنامجك ، والعمل على النسخة 🙂 تأكد ان لغة الكيبورد عندك هي العربية ، احذف كود Public Function f_import_from_excel(w_Files As String) As String كاملا ، اللي عندك ، والصق هذا بدلا عنه ، وتأكد ان الكلمات العربية ظاهرة في الكود بعد لصقه : Public Function f_import_from_excel(w_Files As String) As String 'w_Files = Which Files to use: 'All : all from the current directory 'otherwise , from a selected directory CurrentDb.Execute ("Delete * From mark") CurrentDb.Execute ("Delete * From Temp3") Forms!Mark!barna = Forms!Mark!barna & vbCr & "انتظر من فضلك " Dim strPathFile As String, strFile As String, strPassword, strWorksheet, strTable, strSQL, strPath As String Dim blnHasFieldNames, blnEXCEL, blnReadOnly As Boolean Dim lngCount As Long Dim objExcel As Object, objWorkbook As Object Dim colWorksheets As Collection blnHasFieldNames = False 'w_Files If w_Files = "All" Then strPath = Application.CurrentProject.Path & "\" Else strPath = Me.txtPath End If strWorksheet = "StudentsData" strTable = "Temp3" 'w_Files If w_Files = "All" Then strFile = Dir(strPath & "*.xlsx") Else strFile = Dir(strPath) End If Do While Len(strFile) > 0 strPathFile = strPath & strFile On Error Resume Next Set objExcel = GetObject(, "Excel.Application") If Err.Number <> 0 Then Set objExcel = CreateObject("Excel.Application") blnEXCEL = True End If Err.Clear On Error GoTo 0 blnHasFieldNames = False 'w_Files If w_Files = "All" Then strPathFile = Application.CurrentProject.Path & "\" & strFile ' "C:\Filename.xls" Else strPathFile = Me.txtPath End If strTable = "Temp3" '"tablename" strPassword = vbNullString '"passwordtext" blnReadOnly = True ' open EXCEL file in read-only mode Set colWorksheets = New Collection Set objWorkbook = objExcel.Workbooks.Open(strPathFile, , blnReadOnly, , _ strPassword) For lngCount = 1 To objWorkbook.Worksheets.Count colWorksheets.Add objWorkbook.Worksheets(lngCount).Name Next lngCount objWorkbook.Close False Set objWorkbook = Nothing If blnEXCEL = True Then objExcel.Quit Set objExcel = Nothing For lngCount = colWorksheets.Count To 1 Step -1 DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel9, _ strTable, strPathFile, blnHasFieldNames, colWorksheets(lngCount) & "$" DoEvents Dim rst As DAO.Recordset Dim fld As DAO.Field Dim s_Teach_Name As String Dim s_ID As Long Set rst = CurrentDb.OpenRecordset("Select * From Temp3") rst.MoveLast: rst.MoveFirst RC = rst.RecordCount For i = 1 To RC If i = 7 And Len(rst("F1") & "") <> 0 Then sSubject = rst("F1") s_ID = rst!ID + (RC - 7) 'get the Auto_ID "ID" number for Record#8, then add to it "Total Records" - 8 s_Teach_Name = DLookup("[F5]", "Temp3", "[ID]=" & s_ID) s_Teach_Name = Replace(s_Teach_Name, "اسم المعلم ", "") ElseIf i = 8 And Len(rst("F1") & "") <> 0 Then sSubject = rst("F1") s_ID = rst!ID + (RC - 8) 'get the Auto_ID "ID" number for Record#8, then add to it "Total Records" - 8 s_Teach_Name = DLookup("[F5]", "Temp3", "[ID]=" & s_ID) s_Teach_Name = Replace(s_Teach_Name, "اسم المعلم ", "") ElseIf i = 11 And Len(rst("F1") & "") <> 0 Then sClass = rst("F1") ElseIf i = 12 And Len(rst("F1") & "") <> 0 Then sClass = rst("F1") End If For Each fld In rst.Fields If fld.Value = "المجموع" Then myID = rst!ID + 1 smark = fld.Name fld_Number = Mid(smark, 2) rst.MoveNext ' If IsNumeric(rst("F" & fld_Number + 16).Value) Then sID = rst("F" & fld_Number + 16).Name sName = rst("F" & fld_Number + 12).Name s1 = rst("F" & fld_Number + 10).Name s2 = rst("F" & fld_Number + 9).Name s3 = rst("F" & fld_Number + 7).Name s4 = rst("F" & fld_Number + 5).Name s5 = rst("F" & fld_Number + 2).Name s6 = rst("F" & fld_Number + 1).Name s7 = rst("F" & fld_Number + 21).Name s8 = rst("F" & fld_Number + 21).Name s9 = rst("F" & fld_Number + 21).Name s10 = rst("F" & fld_Number + 21).Name ' ElseIf IsNumeric(rst("F" & fld_Number + 20).Value) Then sID = rst("F" & fld_Number + 20).Name sName = rst("F" & fld_Number + 18).Name s1 = rst("F" & fld_Number + 17).Name s2 = rst("F" & fld_Number + 15).Name s3 = rst("F" & fld_Number + 12).Name s4 = rst("F" & fld_Number + 10).Name s5 = rst("F" & fld_Number + 9).Name s6 = rst("F" & fld_Number + 7).Name s7 = rst("F" & fld_Number + 5).Name s8 = rst("F" & fld_Number + 2).Name s9 = rst("F" & fld_Number + 1).Name s10 = rst("F" & fld_Number + 21).Name ' ElseIf IsNumeric(rst("F" & fld_Number + 19).Value) Then sID = rst("F" & fld_Number + 19).Name sName = rst("F" & fld_Number + 17).Name s1 = rst("F" & fld_Number + 15).Name s2 = rst("F" & fld_Number + 12).Name s3 = rst("F" & fld_Number + 10).Name s4 = rst("F" & fld_Number + 9).Name s5 = rst("F" & fld_Number + 7).Name s6 = rst("F" & fld_Number + 5).Name s7 = rst("F" & fld_Number + 2).Name s8 = rst("F" & fld_Number + 1).Name s9 = rst("F" & fld_Number + 21).Name s10 = rst("F" & fld_Number + 21).Name ' ElseIf IsNumeric(rst("F" & fld_Number + 17).Value) Then sID = rst("F" & fld_Number + 17).Name sName = rst("F" & fld_Number + 15).Name s1 = rst("F" & fld_Number + 12).Name s2 = rst("F" & fld_Number + 10).Name s3 = rst("F" & fld_Number + 9).Name s4 = rst("F" & fld_Number + 7).Name s5 = rst("F" & fld_Number + 5).Name s6 = rst("F" & fld_Number + 2).Name s7 = rst("F" & fld_Number + 1).Name s8 = rst("F" & fld_Number + 21).Name s9 = rst("F" & fld_Number + 21).Name s10 = rst("F" & fld_Number + 21).Name ' ElseIf IsNumeric(rst("F" & fld_Number + 15).Value) Then sID = rst("F" & fld_Number + 15).Name sName = rst("F" & fld_Number + 10).Name s1 = rst("F" & fld_Number + 9).Name s2 = rst("F" & fld_Number + 7).Name s3 = rst("F" & fld_Number + 5).Name s4 = rst("F" & fld_Number + 2).Name s5 = rst("F" & fld_Number + 1).Name s6 = rst("F" & fld_Number + 21).Name s7 = rst("F" & fld_Number + 21).Name s8 = rst("F" & fld_Number + 21).Name s9 = rst("F" & fld_Number + 21).Name s10 = rst("F" & fld_Number + 21).Name End If GoTo Got_the_info End If Next rst.MoveNext Next i Got_the_info: mySQL = "INSERT INTO mark ( StName, StuId, S_Sum, A1, A2, A3, A4, A5, A6, A7, A8, A9, A10, S_Subject, S_Class, Teach_Name )" mySQL = mySQL & " SELECT [" & sName & "], [" & sID & "], [" & smark & "], [" & s1 & "], [" & s2 & "], [" & s3 & "], [" & s4 & "], [" & s5 & "], [" & s6 & "], [" & s7 & "], [" & s8 & "], [" & s9 & "], [" & s10 & "], '" & sSubject & "', '" & sClass & "', '" & s_Teach_Name & "'" mySQL = mySQL & " FROM Temp3" mySQL = mySQL & " GROUP BY [" & sName & "], [" & sID & "], [" & smark & "], [" & s1 & "], [" & s2 & "], [" & s3 & "], [" & s4 & "], [" & s5 & "], [" & s6 & "], [" & s7 & "], [" & s8 & "], [" & s9 & "], [" & s10 & "]" mySQL = mySQL & " HAVING [" & smark & "]<>'المجموع'" 'Debug.Print mySQL CurrentDb.Execute (mySQL) CurrentDb.Execute ("Delete * From Temp3") Next lngCount strFile = Dir() Loop Set colWorksheets = Nothing Forms!Mark!barna = Forms!Mark!barna & vbCr & "تمت عملية الاستيراد بنجاح .. انتقل إلى التقارير " End Function . احفظ البرنامج ، وجرب استيراد ملف الاكسل

ادخل في الكود ، وانقر على مكان الخط الاحمر ، وسيتحول السطر الى هذا اللون . الآن ، اذهب الى النموذج ، واختار الملف ، وانقر على استيراده ، بعد قليل سيرجع التركيز الى هذا السطر ، انفر على زر توقيف الكود: . ارجع الى النموذج ، وافتح الجدول Temp3 ، وخلينا نشوف اذا المادة والصف موجودين هناك .

اشوف عندك آلاف السجلات ، جرب الملف اللي ارسلته لي فقط ، وخليني اشوف النتيجة

نعم ، والشعبة والمادة يظهرون في الجدول Mark

2. استيراد البيانات من الاكسل لا يعتمد على ظهور الحقل من عدمه في الاكسل ، وانما يستورد جميع بيانات الورقة ، 1. من الصورة اللي ارفقتها انا ، تلاحظ اسم المادة والشعبة موجودين في جدول Mark , وقد جربت مرفقك واعطى نفس النتائج !! فما اعرف شو المشكلة !! جعفر

لاحظت ان الكود الاساسي لجلب بيانات الاكسل ، تم عمل نسختين منه : نسخة لحدث زر استيراد الكل ، ونسخة لحدث زر استيراد الملف الذي تم اختياره ، وهذا معناه ، كل تعديل يتم في اي حدث ، يجب تحديثه في الحدث الآخر ، وهذا ، كارثة جمعت لك الحدثين في كود واحد ، والحدث لما ينادي الكود ، يخبره اي حدث هو ، واللي على اساسه يتم اعتماد اسطر معينه (لاحظ الاسطر اللي تبدأ بـ : If w_Files = "All" Then ) ، لهذا السبب ، رجاء استعمل المرفق بدلا عن النسخ الاخرى اللي عندك 🙂 جعفر FMARK.zip

وعليكم السلام 🙂 اسم المدرس يكون موجود من ضمن البيانات التي يتم استيرادها الى الجدول Temp3 ، لهذا السبب ، علينا ان نوقف البرنامج وندقق في الجدول ، واذا استوردنا بيانات ملف الاكسل الذي ارفقته ، نرى انها في آخر سجل ، في الحقل F5 : . وعليه ، الاسطر الثلاث من الكود التالي يجلب لنا الاسم (طبعا بدون تغيير طريقة عمل الكود ككل) : If i = 8 Then sSubject = rst("F1") s_ID = rst!ID + (RC - 8) 'get the Auto_ID "ID" number for Record#8, then add to it "Total Records" - 8 s_Teach_Name = DLookup("[F5]", "Temp3", "[ID]=" & s_ID) s_Teach_Name = Replace(s_Teach_Name, "اسم المعلم ", "") . والتغيير في آخر السطرين ، حتى يتم ادخال المعلومة الى حقل Teach_Name في جدول Mark : mySQL = "INSERT INTO mark ( StName, StuId, S_Sum, A1, A2, A3, A4, A5, A6, A7, A8, A9, A10, S_Subject, S_Class, Teach_Name )" mySQL = mySQL & " SELECT [" & sName & "], [" & sID & "], [" & smark & "], [" & s1 & "], [" & s2 & "], [" & s3 & "], [" & s4 & "], [" & s5 & "], [" & s6 & "], [" & s7 & "], [" & s8 & "], [" & s9 & "], [" & s10 & "], '" & sSubject & "', '" & sClass & "', '" & s_Teach_Name & "'" . والنتيجة : جعفر FMARK.zip

🙂

اهم شيء في الموضوع هو البيانات ، ولما تتوفر ، وبكبسة زر واحدة والاكسس يعمل لك التقرير 🙂 ومثل ما شرحت لك في مشاركتي سابقا ، فتستطيع ان تعمل: . 1. . . او 2. . . عنك الملف ، فتفنن به كيف شئت 🙂 جعفر

تم ارفاق المرفق مع المشاركة الاصل 🙂 جعفر

جرب : جعفر

هذا لأنك ما عندك نموذج فرعي (الآن شفت برنامجك !! ) ، استعمل: set rst= me.recordsetclone جعفر

نعم اذا كنت تريد ان تحدث جميع حقول الجدول 🙂 بينما اذا اردت تحديث حقول النموذج فاستعمل الكود اللي اعطيتك ، لهذه الاسباب : - النموذج قد يكون مصدره استعلام ، وقد يكون هناك تصفية في الاستعلام ، - النموذج الفرعي عادة يكون مرتبط بالنموذج الرئيسي عن طريق ربط حقل ، لذلك فهو عادة يعرض سجلات معينة فقط 🙂 جعفر

تفضل الاستعلامات 🙂 للغياب فقط ، وما ممكن بين تاريخين ، لأن الغائب اصلا ما مسجل له تاريخ غيابه !! . . اما الجميع ، كتبت الحاضر والغائب بالانجليزي ، علشان تشوف المعادلة بالطريقة الصحيحة ، لأن الكلمات العربية بتقلبها!! : . . جعفر 1179.برنامج الحضور والغياب للطلاب بالباركود.accdb.zip

تفضل ، ضع هذا الكود على حدث النقر على الزر 🙂 انا ما جربت الكود ، بس وانا اشرب الشاي كتبته 🙂 dim rst as dao.recordset set rst= me.[اسم النموذج الفرعي حسب ما هو].form.recordsetclone do until rst.EOF rst.edit rst![اسم الحقل الذي تريد ان تفرغه] = null rst![اسم الحقل التالي الذي تريد ان تفرغه] = null ..... rst.update rst.movenext loop . جعفر

وعليكم السلام استاذ مصطفى 🙂 هذه بيانات جداولك : . رجاء تعطينا توضيح وبالتفصيل عن طلبك !! جعفر

وعليكم السلام 🙂 ؟؟ جعفر

السلام عليكم اخوي حسام 🙂 لاحظ الفرق في طريقة عرض الكود في مشاركتك السابقة : بينما يمكنك استخدام الزر : ثم تضع الكود بداخله ، ليصبح هكذا ، وتسهل قراءته 🙂 DLookUp("Gaza","tabGazaa","[Gazdate] <=#" & [Forms]![tblnewtaq]![taqto] & "#" & "and [Gazdate]>=#" & [Forms]![tblnewtaq]![taqfrom] & "#" & "and [gazaeid]=" & [eid]) ------------------------------------------------------------------------------------------------------------------------------------------------------------------- وعليكم السلام اخوي عبد الفتاح 🙂 الكود الذي وضعته انت يشير الى تاريخ ، لذلك ، رجاء اكتب لنا هنا بعض التواريخ اللي في برنامجك (اعمل منها نسخ ولصق حتى نرى الصيغة الصحيحة ) ، واكتب لنا بعض التواريخ التي لا يعطي الكود نتائج صحيحة بها 🙂 يعني مجرد ارفاقك صورة للكود لا يعطينا بيانات كفاية للتفكير معك 😁 ويمكنك ان تجرب Between ، لأنها الطريقة الاخرى لحصر القيم بين تاريخين 🙂 جعفر

مافي فرق بين هذا الكود والكود السابق ، مجرد اسم المتغير اصبح تابع لإسم النموذج : A = Nz(DLookup("[ITEM_BARCODE]& '|' & [ITEM_CODE]", "POS_MASTER", "[ITEM_BARCODE]='" & Me.ITEM_BARCODE & "'"), "|") x = Split(A, "|") Forms!forms1!serh_Barcod = x(0) Forms!forms1!item_no = x(1) جعفر

1. نحن في النموذج Form1 ، ونريد ان نستعمل القيم من النموذج المفتوح Form2 : Me.ITEM_BARCODE = DLookup("[ITEM_BARCODE]", "VW_ITEM_MASTAR", "[ITEM_BARCODE]='" & Forms!forms1!serh_Barcod & "'") Me.ITEM_CODE = DLookup("[ITEM_CODE]", "VW_ITEM_MASTAR", "[ITEM_BARCODE]='" & Forms!forms1!item_no & "'") 2. نحن في النموذج Forms2 ، ونريد ان نرسل القيم الى النموذج المفتوح Forms1 : Forms!forms1!serh_Barcod = DLookup("[ITEM_BARCODE]", "VW_ITEM_MASTAR", "[ITEM_BARCODE]='" & Me.ITEM_BARCODE & "'") Forms!forms1!item_no = DLookup("[ITEM_CODE]", "VW_ITEM_MASTAR", "[ITEM_BARCODE]='" & Me.ITEM_CODE & "'") جعفر

🙂

السبب هو عدد الحقول التي طلبتها ، اضف العلامة | في الدالة NZ ، بعددها في الكود بمعنى عندك 9 علامات : فلازم NZ يكون : جرب هذا A = Nz(DLookup("[ITEM_CODE] & '|' & [deskwn1] & '|' & [item_name] & '|' & [Expr1]& '|' & [Expr2] & '|' & [sub_id] & '|' & [FACTOR]& '|' & [UNT_ID]& '|' & [ITEM_CommissioN]& '|' & [CATEGORY]", "VW_ITEM_MASTAR", "[ITEM_BARCODE]='" & Me.ITEM_BARCODE & "'"), "|||||||||") جعفر

تفضل 🙂 الدالة NZ تحل المشكلة 🙂 A = Nz(DLookup("[SELLS_PRICE]& '|' & [item_name]", "POS_MASTER", "[ITEM_BARCODE]='" & Me.ITEM_BARCODE & "'"), "|") x = Split(A, "|") Me.SELLS_PRICE_2 = x(0) Me.ITEM_NAME_2 = x(1) جعفر