عفرنس

أريد دمج بيانات صفيت في صف واحد UserpasswordDeliveringReport.xlsx

تفضل .. لعله ما تريد az.accdb

تم المطلوب بنجاح .. شكر الله لك وغفر ذنبك .. 😘

اريد باختصار استيراد اسم المعلم من ملف اكسل المرفق ولك مني خالص الدعاء

الأستاذ jjafferr تم تعديل الكود على هذا الشكل .. لكن يعطيني الخطأ التالي :

لدي هذا البرنامج وأريد إضافة الكود التالي فيه وتغيير ما يلزم . تنبيه " لا أريد إضافة الحقول التالية في جدول " A1 A2 A3 A4 A5 A6 A7 A8 A9 A10 "MARK 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 مجلد جديد (2).rar

أبشر

شكر الله لك .. تم المطلوب بنجاح على هذا البرنامج المتعب .. ** أخي جعفر أريد هذا الكود على برنامج آخر مشابه له تماما . ما الذي يمكن تغييره في حال تم حذف الحقول A1 A2 A3 A4 A5 A6 A7 A8 A9 A10 فقط . البرنامج مرفق . مجلد جديد (2).rar

السلام عليكم أخي جعفر .. استوردت ملف الاكسل وظهرت معي هذه الرسالة :

سأوافيك بالتيجة غدا بإذن الله

عملت الخطوات وتم ظهور المادة والشعبة في جدول Temp3

جربته أستاذ جعفر ونفس المشكلة وهذا في حال تغيير ارتفاع الصف

والله ترفض تظهر عندي .. الله أعلم أين المشكلة .. في حال تغيير ارتفاع الصفين تظهر الشعبة والمادة ..

هل جربت ملف اكسل المرسل أخيرا ؟؟ لأنه لا يظهر لي اسم المادة والشعبة إلا إذا غيرت ارتفاع الصف ف الشيت الأول من الاكسل . وهذا متعب لي لأن عندي حوالي 20 ملف اكسل .

شكر الله لك أخي جعفر .. وجزاك خيرا .. بقي عندي مشكلة وهي : عدم استيراد اسم المادة والشعبة . والسبب : لأن ارتفاع الصف رقم 40 و 41 مخفي كما في الصورة وقد أرفقت لك الملف لتجربه ولحل المشكلة .. CS_GetMatchingGrades.rar

UP UP UP أريد في المرفق استيراد اسم المعلم من ملف اكسل إلى حقل Tech_Nam مجلد جديد (2).rar

تفضل .. ان شاء الله هو المطلوب 1استعلام الحاقي.rar

وعليكم السلام أرفق ملفك حتى يتسنى للخبراء فهم ما تريد ومساعدتك وحل مشكلتك

اخواني الفضلاء أريد استيراد الصف الذي فيه اسم المعلم من ملف الاكسل .. أو مالذي يمكن اضافته في الكود حتى يتم استيراده مع بقية البيانات .. دمتم بخير .. مجلد جديد (2).rar

أحسنت .. فائدة جميلة .. ولي عندك طلب لعلك تفزع لي فيI

نسيت أضيف : انه تم تغيير اسم زر الأمر ( تفريغ الحقول ) إلى ( CmdUpdate ) بالتوفيق أخي الكريم .. لا تنس تضغط على أفضل إجابه حتى يتم انه تم حل الموضوع

الأخ حربي العنزي .. عذا الكود وضعناه في زر أمر تفريغ الحقول ( عند النقر ) ومن ثم كتابة اسم الجدول وهو باللون البنفسجي :: وكذلك أسماء الحقول المطلوب تفريغها المشار إليها باللون الأحمر .. Private Sub CmdUpdate_Click() Dim strSQL As String strSQL = "UPDATE TBL1 SET TBL1.daan = NULL, TBL1.mdeen = NULL, TBL1.sumMdeen = NULL, TBL1.sumDaan = NULL, TBL1.rseedMD = NULL, TBL1.rseedDA = NULL, TBL1.mdowrMD = NULL,TBL1.mdowrDA = NULL" DoCmd.SetWarnings False DoCmd.RunSQL strSQL DoCmd.SetWarnings True Me.Requery End Sub وللأمانة فالكود بعد البحث وجدته للأخت زهرة مع تعديل اسم الجدول والحقول فيه .

وهذه مشاركة مني لك بعد اذن الأخ جعفر ProgClac44.rar

الأستاذ gelani البرنامج يعمل تمام انظر للصورة المرفقة .... لا تضيف البيانات أثناء فتح الجدول tbl

أسعدك الله وجزاك خيرا .. سامحني أستاذي الفاضل لو كنت أثقلت عليك ..