اذهب الي المحتوي
أوفيسنا
بحث مخصص من جوجل فى أوفيسنا
Custom Search

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

ناقل

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

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

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

ناقل

ناقل

قام بنشر
قام بنشر 
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

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. او اني اشتغل على الموجود و اجاوب على السؤال بأقل قدر من التغيير ، وهذا اللي عملته 🙂

 

جعفر

  • Like 1
jjafferr

jjafferr

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

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

.

image.png.31876f39543553f4aa5996a35b257a4f.png

.

 

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

.

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

image.png.0d2c9276ebb4f3d46b10d3b702fb0697.png

.

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

 

جعفر

 

 

  • Like 2
  • Thanks 1
ناقل

ناقل

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

حياك الله 🙂

 

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

 

جعفر

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

  • Like 1

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