اذهب الي المحتوي
أوفيسنا

استيراد اسم المدرس مع بقية البيانات - ملف من موقع النور (عنوان معدل)

عفرنس

بواسطه عفرنس
في قسم الأكسيس Access

 مشاركة
إذهب إلى الإجابة الإجابة بواسطة jjafferr,

الردود الموصى بها

عفرنس

عفرنس

قام بنشر
قام بنشر

اخواني الفضلاء 

أريد استيراد الصف الذي فيه اسم المعلم من ملف الاكسل ..

أو مالذي يمكن اضافته في الكود حتى يتم استيراده مع بقية البيانات .. 

دمتم بخير .. 

مجلد جديد (2).rar

jjafferr

jjafferr

قام بنشر
قام بنشر

وعليكم السلام 🙂

 

اسم المدرس يكون موجود من ضمن البيانات التي يتم استيرادها الى الجدول Temp3 ،

لهذا السبب ، علينا ان نوقف البرنامج وندقق في الجدول ،

واذا استوردنا بيانات ملف الاكسل الذي ارفقته ، نرى انها في آخر سجل ، في الحقل F5 :

image.png.0e64607d558b1b6b30544ba9d46b1176.png

.

وعليه ، الاسطر الثلاث من الكود التالي يجلب لنا الاسم (طبعا بدون تغيير طريقة عمل الكود ككل) : 

        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 & "'"

.

والنتيجة :

image.png.faf50c8addfa20e6a55e0db32f98553e.png

 

جعفر

FMARK.zip

  • Like 3
jjafferr

jjafferr

قام بنشر
قام بنشر

لاحظت ان الكود الاساسي لجلب بيانات الاكسل ، تم عمل نسختين منه :

نسخة لحدث زر استيراد الكل ، ونسخة لحدث زر استيراد الملف الذي تم اختياره ،

وهذا معناه ، كل تعديل يتم في اي حدث ، يجب تحديثه في الحدث الآخر ، وهذا ، كارثة :blink:

 

جمعت لك الحدثين في كود واحد ، والحدث لما ينادي الكود ، يخبره اي حدث هو ، واللي على اساسه يتم اعتماد اسطر معينه (لاحظ الاسطر اللي تبدأ بـ : If w_Files = "All" Then ) ،

لهذا السبب ، رجاء استعمل المرفق بدلا عن النسخ الاخرى اللي عندك 🙂

 

جعفر

FMARK.zip

عفرنس

عفرنس

قام بنشر
  • الكاتب
قام بنشر

شكر الله لك أخي جعفر .. وجزاك خيرا ..

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

وقد أرفقت لك الملف لتجربه ولحل المشكلة .. 

  

image.png

CS_GetMatchingGrades.rar

jjafferr

jjafferr

قام بنشر
قام بنشر
34 دقائق مضت, emam1424 said:

1. عدم استيراد اسم المادة والشعبة .

2. والسبب : لأن ارتفاع الصف رقم 40 و 41 مخفي كما في الصورة

 

2. استيراد البيانات من الاكسل لا يعتمد على ظهور الحقل من عدمه في الاكسل ، وانما يستورد جميع بيانات الورقة ،

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

 

جعفر

عفرنس

عفرنس

قام بنشر
  • الكاتب
قام بنشر
2 دقائق مضت, jjafferr said:

 

2. استيراد البيانات من الاكسل لا يعتمد على ظهور الحقل من عدمه في الاكسل ، وانما يستورد جميع بيانات الورقة ،

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

 

جعفر

هل جربت ملف اكسل المرسل أخيرا ؟؟ 

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

وهذا متعب لي لأن عندي حوالي 20 ملف اكسل . 

jjafferr

jjafferr

قام بنشر
قام بنشر
5 دقائق مضت, emam1424 said:

هل جربت ملف اكسل المرسل أخيرا ؟؟ 

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

عفرنس

عفرنس

قام بنشر
  • الكاتب
قام بنشر
8 دقائق مضت, jjafferr said:

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

والله ترفض تظهر عندي .. 

الله أعلم أين المشكلة .. 

image.png.ec034a6ac42fa8cf106f353b006b3d98.png

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

عفرنس

عفرنس

قام بنشر
  • الكاتب
قام بنشر
1 دقيقه مضت, jjafferr said:

اشوف عندك آلاف السجلات ،

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

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

image.png.613966a618b4151567370f41cf9e294f.png

وهذا في حال تغيير ارتفاع الصف

image.png.ea264054bb6b364d95706b48e10bac2b.png

jjafferr

jjafferr

قام بنشر
قام بنشر

ادخل في الكود ، وانقر على مكان الخط الاحمر ، وسيتحول السطر الى هذا اللون

image.png.216a92c5cebaa3cc9ae50ed777088bb3.png

.

الآن ، اذهب الى النموذج ، واختار الملف ، وانقر على استيراده ،

بعد قليل سيرجع التركيز الى هذا السطر ، انفر على زر توقيف الكود:

image.png.e25934b88e0c2b83b501e189cf004682.png

.

ارجع الى النموذج ، وافتح الجدول Temp3 ، وخلينا نشوف اذا المادة والصف موجودين هناك .

عفرنس

عفرنس

قام بنشر
  • الكاتب
قام بنشر
6 دقائق مضت, jjafferr said:

ادخل في الكود ، وانقر على مكان الخط الاحمر ، وسيتحول السطر الى هذا اللون

image.png.216a92c5cebaa3cc9ae50ed777088bb3.png

.

الآن ، اذهب الى النموذج ، واختار الملف ، وانقر على استيراده ،

بعد قليل سيرجع التركيز الى هذا السطر ، انفر على زر توقيف الكود:

image.png.e25934b88e0c2b83b501e189cf004682.png

.

ارجع الى النموذج ، وافتح الجدول Temp3 ، وخلينا نشوف اذا المادة والصف موجودين هناك .

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

image.png.569f21c6cfc9c5f0cccc84ce3d11a9fc.png

  • تمت الإجابة
jjafferr

jjafferr

قام بنشر
  • تمت الإجابة
قام بنشر (معدل)

رجاء عمل نسخة من برنامجك ، والعمل على النسخة 🙂

 

تأكد ان لغة الكيبورد عندك هي العربية ،

احذف كود 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

.

احفظ البرنامج ، وجرب استيراد ملف الاكسل

تم تعديل بواسطه jjafferr
تعديل الرقم ، كما في اشرت لها في مشاركة لاحقة
jjafferr

jjafferr

قام بنشر
قام بنشر (معدل)

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

 

جعفر

 

FMARK.zip

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

عفرنس

قام بنشر
  • الكاتب
قام بنشر
9 ساعات مضت, jjafferr said:

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

 

جعفر

FMARK.zip 143.73 kB · 2 تنزيلات

السلام عليكم أخي جعفر ..

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

image.png.89a9155fb291e6d5a0b862c4cd1c3fc8.png

image.png.75e0fdc0f580a5e97f64c948a27c3c83.png

عفرنس

عفرنس

قام بنشر
  • الكاتب
قام بنشر
7 دقائق مضت, jjafferr said:

وعليكم السلام 🙂

 

لوسمحت تغير الرقم حسب الصورة

image.png.dcaf32c7e2a84ac71204afcb55199097.png

 

جعفر

شكر الله لك .. 

تم المطلوب بنجاح على هذا البرنامج المتعب ..

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

البرنامج مرفق . 

image.png.a6ae72868e348f7c103892c906e1d23d.png

مجلد جديد (2).rar

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.

زائر
اضف رد علي هذا الموضوع....

×   Pasted as rich text.   Paste as plain text instead

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

×
 مشاركة
الذهاب الي قائمه المواضيع

  • تصفح هذا الموضوع مؤخراً   0 اعضاء متواجدين الان

    • لايوجد اعضاء مسجلون يتصفحون هذه الصفحه
×
×
  • اضف...

Important Information

  I accept