jjafferr

السلام عليكم 🙂 هذا اللي توصلت اليه 🙂 . . استورد الكائنات من المرفق الى برنامجك الاصل 🙂 جعفر 1182.2020-3-10 (18-45-43).mdb.zip

وعليكم السلام 🙂 بعد ان انزلته ، شفت ان فيه بيانات شبه خاصة ، فحذفته من مشاركتك 🙂 ولا حاجة لرفع المرفق مرة ثانية 🙂 الاستعلام اللي عملناه في السؤال الآخر ، هو في الواقع نفسه اللي نحتاج له هنا ، ولكن بسبب اختلاف مسميات الحقول ، فأقوم حاليا بتغييرها 🙂 جعفر

شكرا جزيلا 🙂 والرسالة واضحة ، والعنصر الذي لم يتم العثور عليه ، يكون احد مكونات السطر المظلل باللون الاصفر 🙂 للعلم 🙂 جعفر

استخدم هذا البرنامج ، ليحذف متبقى الاشياء القديمة ثم استخدم برنامج الضغط winrar او winzip او البرنامج المجاني 7z من (www.7zip.org) ، ثم ارفع البرنامج 🙂 جعفر

تفضل 🙂 والمعلم على رأسي 🙂 جعفر 1180.02.MARK.zip

وعليكم السلام 🙂 اذا اردت الجواب السريع على الاسئلة ، رجاء تعطي اكبر كمية من المعلومات ، ولا تخلينا نخمن او حتى نسألك 🙂 اي تقرير ؟ وين الكمبوبوكس ، في اي نموذج ؟ جعفر

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

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

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

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

السلام عليكم 🙂 اسمحوا لي يا شباب 🙂 هل انتبهتوا ان تاريخ هذا الموضوع هو 10/6/2017 🙄 يُغلق . جعفر

وعليكم السلام 🙂 تفضل الخطوة الاولى 🙂 ادخال البيانات ، اما الخطوة التالية فتكون التقرير ، والذي سيعتمد على استعلام 🙂 جعفر 1182.Projects.zip

وعليكم السلام 🙂 هذا الموضوع فيه الجزئية التي تفيدك ان شاء الله 🙂 جعفر

الحمدلله 🙂 رجاء افتح موضوع جديد لهذا السؤال الجديد 🙂 جعفر ولا تنسى 🙂 جعفر

الحمدلله 🙂 رسالة الخطأ كانت بتعطينا تلميح عن مكان وجود الخطأ 🙂 جعفر

وعليكم السلام 🙂 لوسمحت تغير الرقم حسب الصورة جعفر

وعليكم السلام 🙂 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