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

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

قام بنشر

الأخوة الأعزاء ...    أسعد الله أوقاتكم بكل خير
بالمرفقات قاعدة بيانات أكسس باسم "استيراد" و ملف إكسل باسم "admin"
داخل قاعدة البيانات جدول ونموذج استيراد
وداخل ملف إكسل عدد من أوراق العمل فيها بيانات

المطلوب : كود استيراد بيانات محددة (خلايا محددة) من جميع أوراق ملف إكسل إلى جدول بداخل أكسس ( البيانات المطلوبة موجودة داخل جدول "data_talib" تم إدخال البيانات يدوياً والمطلوب كود لعمل ذلك برمجياً ) .
أتمنى منكم مساعدتي في ذلك ولكم كل الشكر والتقدير . 

استيراد.rar

قام بنشر

أشكر لك تفاعلك أستاذي ولكن اطلعت على هذا الموضوع قبل أن أضيف موضوعي هذا ولم أستطع أن أتوصل إلى حل لأن ملف الإكسل مختلف وحاولت التعديل عليه دون فائدة " لقلة خبرتي بالبرمجة " وأكثر ما أتعبني عند الاستيراد لا يستورد سوى الشيت الأول فقط .

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

أشكر لكم تعاونكم

قام بنشر

السلام عليكم :rol:

 

اذا الاستاذ الجندبي بيدلو بدلوه ، ففيه الخير والبركة ، وانا ارفع يدي عن الموضوع :rol:

 

 

جعفر

قام بنشر

وأتمنى ان الأستاذ as2003fm يقوم بإرفاق ملف الاكسل المصدر من نور كما هو بدون تعديل قبل أن يعمل الأستاذ جعفر على البرنامج

حتى يقوم باستيراد جميع البيانات منه وخاصة رقم الهوية

  • Like 1
قام بنشر
3 ساعات مضت, jandbi said:

وأتمنى ان الأستاذ as2003fm يقوم بإرفاق ملف الاكسل المصدر من نور كما هو بدون تعديل قبل أن يعمل الأستاذ جعفر على البرنامج

حتى يقوم باستيراد جميع البيانات منه وخاصة رقم الهوية

رحم الله والديك ، انا ما انتبهت لهذه القضية ، صحيح اني شفت مجرد 7 اوراق في ملف الاكسل ، لكني قلت هذا كل اللي عندهم.

 

أخي as2003fm ، مثل ما لاحظت انت انه مب سهل جلب البيانات ، وفيه شغل ، ولكن بعد الشغل تفاجأني (مثل بعض الناس :wink2:) وترفق لي الملف الحقيقي علشان اضبطه ، يصير لي احباط :blink:

فرجاء من البداية ارفق الملف الاصل ، واذا البيانات حساسة ، ارفعه في احد المواقع ، وارسل لي الرابط برسالة على بريدي الخاص :rol:

 

انتوا المدرسين حالة خاصة على الخاص :rol:

 

 

جعفر

  • Like 1
قام بنشر

بالنسبة للملف المرفق لم أغير سوى الأسماء فقط .

وأما بالنسبة لرقم الهوية فلا تظهر أبداً في الملف المستورد من نور .

تم الإرسال

قام بنشر
في ٢٧‏/١٢‏/٢٠١٥ at 22:01, jandbi said:

أسعد الله أوقاتكم

فعلاً ... راجعت الموضوع الذي بالرابط بتأني وتركيز فوجدت فيه الفائدة الكبيرة ( يمكن كنت مستعجل سابقاً  :imsorry: )

أشكر أساتذتي الذين أثروا الموضوع ...

لكم كل تحية وتقدير  :fff::fff::fff:

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

حياك الله :rol:

 

هل افهم من كلامك انك خلصت الموضوع؟

انا اعتذر منك ، انشغلت باشياء ثانية :blink:

 

 

جعفر

بارك الله فيك وبعلمك .. بدأت في البرنامج ولله الحمد خطوة وإذا واجهتني أي مشكلة سأبحث بالمنتدى وأطبق بإذن الله .

طبعاً ما أستغني عنكم ... ستجد موضوع جديد أطلب فيه المساعدة عند أول مطب صناعي :wavetowel:

يسعدني تواصلك  :fff:

قام بنشر

في الواقع انا بدأت العمل في البرنامج ، ولكن للأسف توقفت :blink:

 

الشئ اللس لاحظته في ملف الاكسل ، ان كل طالب عنده صفحتين ، واحدة للحصص ، والثانية اعتقد للدين او ما شابه ذلك ، وهي مادة واحدة فقط وبدون علامات ، فايش تريد ان تعمل بها؟

 

جعفر

قام بنشر

رحم الله والديك أخوي حسين :rol:

 

انا متأكد ان الاخوة المدرسين ممكن يستفيدوا من المرفق ،

لكن بالنسبة لي ، المجلدات كثيرة ، بس اكيد صاحب الحاجة بيعرف طريقه :rol:

 

 

جعفر

  • Like 1
قام بنشر (معدل)
Public Function zaImportAllSheets()
Dim blnHasFieldNames As Boolean, blnEXCEL As Boolean, blnReadOnly As Boolean
Dim lngCount As Long
Dim objExcel As Object, objWorkbook As Object
Dim colWorksheets As Collection
Dim strPathFile As String, strTable As String

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 = True
strPathFile = txtPath
strTable = "Sheet"
blnReadOnly = True
Set colWorksheets = New Collection
Set objWorkbook = objExcel.Workbooks.Open(strPathFile, , blnReadOnly)
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, 8, strTable, strPathFile, False, colWorksheets(lngCount) & "$"
Next lngCount
Set colWorksheets = Nothing
End Function

أستاذنا الكبير الغالي :
استفدت الفكرة التي قد يحتاج إليها السائل لاستيراد عدد محدد من أوراق الأكسل من أستاذتنا الكريمة : زهرة .
وما تضمنه الملف السابق من استيراد نتائج الفترات أو نهاية الفصل (للمرحلتين المتوسطة والثانوية [عام - فصلي - مقررات- تحفيظ] أو جداول المقررات ، أو الكشوف و بيانات الطلاب ، و استيراد الأسماء وإعادة تصديرها للبرامج القديمة الداعمة لمعارف)

تم تعديل بواسطه Hosain21
  • Like 2
قام بنشر
5 دقائق مضت, Hosain21 said:

أستاذنا الكبير الغالي :
استفدت الفكرة التي قد يحتاج إليها السائل لاستيراد عدد محدد من أوراق الأكسل من أستاذتنا الكريمة : زهرة .
وما تضمنه الملف السابق من استيراد نتائج الفترات أو نهاية الفصل (للمرحلتين المتوسطة والثانوية [عام - فصلي - مقررات- تحفيظ] أو جداول المقررات ، أو الكشوف و بيانات الطلاب ، و استيراد الأسماء وإعادة تصديرها للبرامج القديمة الداعمة لمعارف)

.

انا كذلك استخدم نفس الكود عيناً ، ولكني وجدته في احد المواقع الاجنبية ،

ولكن ولكل ملف اكسل طريقة خاصه لإستخلاص نتائجه ،

فانا غيرت الشئ البسيط في الكود ، وبدل ان يقرأ جميع اوراق الاكسل ويضع نتائجها في جدول واحد في الاكسس ، قمت بطلب كل ورقة على حدة ، الى جدول مؤقت ، ثم عن طريق الاستعلامات ، استخلص نتائج الطالب الى الجدول النهائي :rol:

كل مبرمج عنده طريقة للتعامل مع المسألة :rol:

 

 

جعفر

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

شكرا اخ حسين !

جميل جدا ذكر المرجع عندما لا تكون مالكا للكود ! اعتبرها اقل شي يمكن تقديمه لمن استفدت منه بل عندما يكون عملك نقل بحت !

وهنا احب اسال اخينا السائل : اطلعت على شكل الجدول المطلوب فلم افهم لماذا وضعته بهذا الشكل ! تريد ان تصل لماذا ؟

 

تحياتي

تم تعديل بواسطه رمهان
  • Like 1
  • 5 months later...
  • 2 years later...
قام بنشر

عملت على هذا مدة وبعد تعب وبحث وجدت كودا كاملا في موقع اجنبي وترجمته وهذا هو

 

Public Function yhy39impAllSheets()
Dim blnHasFieldNames As Boolean, blnEXCEL As Boolean, blnReadOnly As Boolean
Dim lngCount As Long
Dim objExcel As Object, objWorkbook As Object
Dim colWorksheets As Collection
Dim strPathFile As String, strTable As String
Dim db As DAO.Database
Dim tdf As DAO.TableDef
'Dim strPassword As String


'**********عملية الاستيراد  من بيانات جميع اوراق العمل في ملف اكسيلل الى جداول منفصلة************

'كود تفاعلي  لربط البيانات  من كل اوراق العمل من ملف اكسلل مفرد وكل بيانات ورقة ستربط بجدول منفصل باسم ورقة العمل
'(مثال'"Sheet1").

' تاسيس كائن لتطبيق الاكسلل
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

' غير الخطوة القادمة الى
'True لاظهار اسماء الاعمدة في الصف الاول في الاكسلل
blnHasFieldNames = False

''''''' غير المسار التالي الى المسار الذي تريده'''''''''
'strPathFile = "c:\myfile.xls"
strPathFile = Me.txtPath
'''''''''''''''''''''''''''''''''''''''''''''''''''

' استبدل password بكلمة المرور الحقيقية  ;
' اذا لم يكن هناك حاجة لكلمة المرور, استبدلها بـvbNullString constant
' (مثال, strPassword = vbNullString)

'strPassword = "passwordtext"


'strTable = "Sheet"

' = true  افتح ملف الاكسلل للقراءة فقط
blnReadOnly = True

' افتح ملف الاكسلل ثم اقرأ أسماء مجموعة اوراق العمل
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 = 1 To colWorksheets.Count Step 1
      DoCmd.TransferSpreadsheet acLink, acSpreadsheetTypeExcel9, colWorksheets(lngCount), strPathFile, blnHasFieldNames, colWorksheets(lngCount) & "$"
Next lngCount

     'DoCmd.TransferSpreadsheet acLink, 8, strTable, strPathFile, False, colWorksheets(lngCount) & "$"

' حذف المجموعة
Set colWorksheets = Nothing
DoCmd.Rename sheet2, acDefault, CS_SchoolStudentsAlphabeticallyReport
Refresh
' قم بتفعيل  خطوة التعليمات البرمجية التالية إذا كنت تريد حذف ملف إكسيل بعد أن يتم استيراده

 'Kill strPathFile
'*************************************انتهت عملية الاستيراد*********************************


End Function

 

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