طلب شرح هذا الجزء من كود استيراد من الاكسل

[ناقل]

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

السؤال : مطلوب شرح مبسط للكود

الاستفسار : لماذا لم نستخدم في استيراد اسم المعلم بنفس طريق استيراد اسم المادة والشعبة في الكود ؟؟؟؟؟؟؟؟؟

 

أصل الموضوع هنا ...............

في ١٠‏/٣‏/٢٠٢٠ at 10:40, emam1424 said:

لدي هذا البرنامج وأريد إضافة الكود التالي فيه وتغيير ما يلزم . 

تنبيه " لا أريد إضافة الحقول التالية في جدول   " 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).rarFetching info...

 

[عفرنس]

1 ساعه مضت, ناقل said:

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

السؤال : مطلوب شرح مبسط للكود

الاستفسار : لماذا لم نستخدم في استيراد اسم المعلم بنفس طريق استيراد اسم المادة والشعبة في الكود ؟؟؟؟؟؟؟؟؟

 

أصل الموضوع هنا ...............

 

لعل الاستاذ jjafferr 

يفيدنا .. 

[jjafferr]

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

 

الكود الاصل انا كنت عامله (من زمان 🙂 ) ،

 

وبعدها تم تعديله وتعديله حسب طلب السائل بواسطة الاعضاء الشباب في المنتدى 🙂

ولما تم طرح السؤال الاخير بواسطة الاستاذ فايز ، شفت الكود كاملا مثل ما حضرتك تفضلت وارفقته 🙂

لاحظت ان التعديلات اللي قاموا فيها الشباب لا تسمح بالكود ان يقرأ جميع السجلات ، فكان يخرج من القراءه على السطر GoTo Got_the_info الموجود في الكود في الاسفل :

1 ساعه مضت, ناقل said:

                            s10 = rst("F" & fld_Number + 21).Name
                         
                                         
                        End If
        
                    GoTo Got_the_info
                End If
            Next
        
            rst.MoveNext
        Next i

Got_the_info:

 

.

كان عندي حلين:

1. يا اني الغي كل الكود واغيره الى طريقتي ، وما كان فيه داعي ، لأن الكود كان يعطي نتائج صحيحة ،

2. او اني اشتغل على الموجود و اجاوب على السؤال بأقل قدر من التغيير ، وهذا اللي عملته 🙂

 

جعفر

[jjafferr]

وهنا انا شرحت ليش قمت بهذه الطريقة:

.

.

 

بينما في السؤال الآخر للاستاذ فايز :

.

ما انتبهت للكود كاملا ، فوضعت نفس الكود ، ولكن للسطر التالي (12 بدلا عن 8 )  :

.

والنتيجة نفسها طبعا ، مع الاخذ في الاعتبار اني نقصت من 12 بدلا عن 8 🙂

 

جعفر

 

 

[ناقل]

بارك الله فيك سيد جعفر وغفر ذنبك وجعل الجنة مثواك ....... وجميع المسلمين .....

اشكرك .... تم الفهم 

[jjafferr]

حياك الله 🙂

 

يعني ما بتنقص درجاتي لأني اختصرت الطريق 😁

 

جعفر

[ناقل]

10 دقائق مضت, jjafferr said:

حياك الله 🙂

 

يعني ما بتنقص درجاتي لأني اختصرت الطريق 😁

 

جعفر

بالعكس العلامة كاملة