jjafferr

وعليكم السلام 🙂 يا ريت ترفق لنا صورة من اللي موجود عندك ، وصورة من اللي تريده (سواء ببرنامج الرسام او الوورد او الاكسل او ... ) ، حتى يتضح السؤال 🙂 جعفر

السلام عليكم 🙂 اسمحوا ان ادلو بدلوي 🙂 الموضوع هذا تكملة للموضوع: . المشكلة الموجودة عندك حاليا هي: 1. الامر الموجود في الكود : rst.MoveNext يجعل المؤشر ينتقل من سجل الى الذي يليه ، وفي النهاية يبقى على آخر سجل ، فلما تشغل الكود مرة ثانية ، لا يعمل لأنه لازال على آخر سجل 🙂 والعمل ، انك لما تشغل الكود ، ومن البداية تخبره ان يذهب الى اول سجل : rst.MoveFirst 🙂 2. لما تخرج من النموذج وتدخل فيه مره ثانية ، فواقعا انت تعيد المؤشر على اول سجل (لأن الكود لم يعمل بعد 🙂 ) . واذا ادخلت قيمة في حقل ، وعلى طول نقرت على زر تفريغ البيانات ، فقيمة هذا الحقل لن يتم تصفيتها ، لأنها لاتزال في وضع تعديل/Edit (اقرأ التفصيل هنا) : . لذلك يجب ان نبدأ بحفظ السجلات ، وهذا الامر يقوم بذلك: If Me.Dirty Then Me.Dirty = False وعليه سيعمل الكود بالطريقة الصحيحة 🙂 اليك الكود بعد الاضافات اعلاه : Dim rst As dao.Recordset If MsgBox("هل تريد حذف البيانات", vbYesNo, "تنبيه") = vbYes Then If Me.Dirty Then Me.Dirty = False Set rst = Me.RecordsetClone rst.MoveFirst Do Until rst.EOF rst.Edit rst![mdowrMD] = Null rst![mdowrDA] = Null rst![mdeen] = Null rst![daan] = Null rst.Update rst.MoveNext Loop Else Exit Sub End If 'MsgBox . جعفر

وعليكم السلام 🙂 الطريقة الجديدة اللي توصلت لها هي عمل وحدة نمطية ، في برنامج الواجهة (ليس على السيرفر) تقوم بالتالي: - عمل ملف txt صغير على جهاز السيرفر، - قراءة الوقت الذي تم فيه عمل الملف (من اعدادات الملف) ، وهو الوقت الذي نريده ، -حذف الملف Public Function Make_File() Dim BE_Path, PauseTime, Start 'get the server path BE_Path = DLookup("[Database]", "MSysObjects", "[Flags]=2097152") 'Path and BE name BE_Path = Mid(BE_Path, 1, InStrRev(BE_Path, "\")) BE_Path = BE_Path & "dummy.txt" 'make the dummy txt file Open BE_Path For Output As #1 Print #1, "No text required" Close #1 'pasue for a second, until file is recognized, for slow networks PauseTime = 1 ' Set duration. Start = Timer ' Set start time. Do While Timer < Start + PauseTime DoEvents ' Yield to other processes. Loop 'get the date created Make_File = FileDateTime(BE_Path) 'clean up, delete the file Kill BE_Path End Function . وننادي هذه الوحدة النمطية هكذا: Me.srver_Time = Make_File() . وبما ان ملف الجداول يكون في مجلد يسمح فيه بإنشاء/تعديل/حذف ملف ، فهذه الطريقة المفروض انها تشتغل 🙂 طريقة العمل هي ان تضع ملف my_BE.mdb على السيرفر ، وملف my_FE.mdb على كمبيوترك ، ثم تربط جدول الواجهة مع جدول الخلفية (سيسألك البرنامج عن فتحه) 🙂 جعفر Server Time.zip

وعليكم السلام 🙂 الاكسس ليس فيه خاصية تصغير حجم كائنات التقرير ليتناسب مع حجم ورقه واحدة (كما في الاكسل) ، لذا ، فعندك طريقتين: 1. الطريقة الموجودة في الاكسس هو يدويا في تصميم التقرير ، اعمل على الكائنات من حقول ونوع/حجم الخط ، بحيث تجعلهم اصغر شيء ممكن ، وبهذه الطريقة وبعد تصغير الكائنات ، سيكون التقرير في وضع التصميم اضيق افقيا (مما يعني تستطيع عمل 3 اعمدة او اكثر، بدل العمودين) ، واقصر عموديا (مما يعني سجلات اكثر) ، وانت وحظك ، في هل ستكون جميع سجلات المشروع في صفحة واحدة او لا 🙂 2. ممكن تصدير التقرير للاكسل ، ومنها تقدر يدويا/برمجيا ان تجعل الطباعة في صفحة واحدة (بس طبعا لازم تشتغل على #1 اعلاه 🙂 ) . وقبل ان تعمل اي شيء، تأكد ان عندك عدد الحقول صحيح : وبعدين لازم انك تلعب/تغير في التقرير الى ان ترى انه مناسب 🙂 جعفر

السلام عليكم 🙂 هذا اللي توصلت اليه 🙂 . . استورد الكائنات من المرفق الى برنامجك الاصل 🙂 جعفر 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 ، وخلينا نشوف اذا المادة والصف موجودين هناك .

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