النهر العطشان قام بنشر أغسطس 23, 2021 قام بنشر أغسطس 23, 2021 السلام عليكم ورحمة الله وبركاته في المرفق قاعدة بيانات تعمل على استيراد بيانات من ملف اكسل خارجي طريقة عملها هو عند الضغط على زر (تحديد المسار) تقوم بفتح نافذه واستيراد البيانات فورا احتاج التعديل عليها باضافة زر اخر كما بالصورة المرفقة فيكون عمل البرنامج هو . 1- زر (تحديد المسار) يقوم بتحديد مسار الملف في الكمبيوتر فقط 2- اضافة زر جديد (استيراد بيانات) يقوم بعملية نقل البيانات من ملف الاكسل الخارجي المحدد بالزر الاول . يرجى استخدام نفس الكود في التعديل وشكرا Access-Import.accdb
husamwahab قام بنشر أغسطس 23, 2021 قام بنشر أغسطس 23, 2021 تفضل التعديل ارجو ان يكون طلبك Access-Import-1.rar 3 1
النهر العطشان قام بنشر أغسطس 23, 2021 الكاتب قام بنشر أغسطس 23, 2021 شكرا استاذنا الفاضل husamwahab جعلها الله في ميزان حسناتك وهو المطلوب استاذي الفاضل هل يمكن معرفة عدد السجلات التي سيتم نقلها برساله كما في الصورة وشكرا
husamwahab قام بنشر أغسطس 23, 2021 قام بنشر أغسطس 23, 2021 بالخدمة استاذ ورحم الله والديك تفضل التعديل الخاص بعدد السجلات التي سيتم نقلها ملاحظة : الكود منقول للامانة مع بعض التعديلات و يرجى التاكد من فاعليته Access-Import-2.rar 3 1
النهر العطشان قام بنشر أغسطس 24, 2021 الكاتب قام بنشر أغسطس 24, 2021 السلام عليكم ورحمة الله وبركاته شكرا استاذنا الفاضل husamwahab جعلها الله في ميزان حسناتك وهو المطلوب 1
محمد التميمي قام بنشر سبتمبر 5, 2021 قام بنشر سبتمبر 5, 2021 في ٢٣/٨/٢٠٢١ at 22:48, husamwahab said: بالخدمة استاذ ورحم الله والديك تفضل التعديل الخاص بعدد السجلات التي سيتم نقلها ملاحظة : الكود منقول للامانة مع بعض التعديلات و يرجى التاكد من فاعليته Access-Import-2.rar 25.57 kB · 16 downloads السلام عليكم استاذ حسام تم التاكد من فعالية الكود وهو يعمل بامتياز ولاكن قمت بتعديل على الجدول للتاكد من فعالية العمل مع الترقيم التلقائي وقد نجح التعديل قمت باضافة حقل id الى الجدول وجعلته ترقيم تلقائي وبالمقابل انشأت ملف اكسل بنفس حقول الجدول باستثناء حقل الترقيم التلقائي واجريت عملية الاستيرا للبيانات عدة مرات ونجح الامر وكلما اجريت عملية استيراد لسجلات جديدة يقوم الترقيم التلقائي بالعمل حسب الاصول سؤالي : هل هذه الطريقة فعالة وخالية من المشاكل مستقبلا اذا ازداد عدد السجلات وبلغ الالف جزاك الله خير الجزاء
husamwahab قام بنشر سبتمبر 6, 2021 قام بنشر سبتمبر 6, 2021 عليكم السلام ورحمة الله وبركاته استاذ محمد 23 ساعات مضت, محمد التميمي said: تم التاكد من فعالية الكود وهو يعمل بامتياز جزاك الله كل خير فقد اكدت لي ولصاحب الموضوع فاعلية الكود 23 ساعات مضت, محمد التميمي said: هل هذه الطريقة فعالة وخالية من المشاكل مستقبلا اذا ازداد عدد السجلات وبلغ الالف سبق وان اشرت ان الكود منقول وقد اجريت تجربة لسجلات محدودة والنتيجة كما اشرت جيدة ولكن ليس لي الخبرة للبت في فاعلية الكود وخلوه من من المشاكل لذا السؤال يحال الى اصحاب الخبرة اساتذتنا الاجلاء جزاهم الله كل خير وعذرا للتقصير 1
محمد التميمي قام بنشر سبتمبر 6, 2021 قام بنشر سبتمبر 6, 2021 انشاء الله يتفاعل الاخوة معنا شكرا استاذ حسام 1
hassansaat قام بنشر سبتمبر 18, 2021 قام بنشر سبتمبر 18, 2021 السلام عليكم ارجو حل هذه المشكلة عند الضغط على زر الاستيراد تظهر هذة الرسالة يمكن أن يحدث هذا الخطأ عند فشل تشغيل حدث لأنه تعذر تقييم موقع منطق هذا الحدث. على سبيل المثال، في حالة تعيين الخاصية 'عند_الفتح' لأحد النماذج إلى =[حقل]، يحدث هذا الخطأ إذ من المتوقع أن يتم تشغيل اسم حدث أو ماكرو عند بدء الحدث. Access-Import.accdb
د.كاف يار قام بنشر سبتمبر 18, 2021 قام بنشر سبتمبر 18, 2021 @hassansaat تعلم الاستيراد بكل سهولة في البداية قم بإستدعاء مكتبة الإكسل الآن نقوم بإنشاء Module جديد و اضافة الكود التالي Public filenname As String Public Function importExcel(tablename As String) As String ', filenname As String Dim xlApp As Excel.Application Dim xlWb As Excel.Workbook Dim xlWs As Excel.Worksheet Dim intLine As Long Dim strSqlDml As String Dim strColumn1 As String, strColumn2 As String, strColumn3 As String varfile = filenname CurrentDb.Execute "DELETE * FROM List", dbFailOnError Set xlApp = New Excel.Application xlApp.Visible = False Set xlWb = xlApp.Workbooks.Open(varfile) Set xlWs = xlWb.Worksheets(1) intLine = 2 Do strColumn1 = Trim(xlWs.Cells(intLine, 1).Value) strColumn2 = Trim(xlWs.Cells(intLine, 2).Value) strColumn3 = Trim(xlWs.Cells(intLine, 3).Value) strSqlDml = "INSERT INTO List VALUES('" & strColumn1 & "', '" & strColumn2 & "', '" & strColumn3 & "')" CurrentDb.Execute strSqlDml, dbFailOnError xlWs.Cells(intLine, 1).Select intLine = intLine + 1 Loop Until IsEmpty(xlWs.Cells(intLine, 1)) xlWb.Close False xlApp.Quit Set xlApp = Nothing Set xlWb = Nothing Set xlWs = Nothing filenname = "" End Function Public Sub SelectFiles() Dim Addfile As Object Set Addfile = Application.FileDialog(3) With Addfile .AllowMultiSelect = False .InitialFileName = "" .Filters.Clear .Filters.Add "Excel Files", "*.xls,*.xlsx" If .Show = True Then filenname = Trim(.SelectedItems(1)) Else Exit Sub End If End With End Sub شرح مختصر للكود نقوم بالإعلان عن متغييرات تحمل اسماء مستعارة للأعمدة في ملف الإكسل مثلا strColumn1 -strColumn2 - strColumn3 Dim strColumn1 As String, strColumn2 As String, strColumn3 As String الأن نقوم بتعريف المتغييرات على الأعمدة في ملف الأكسل من خلال التعريف xlWs.Cells(intLine, 1).Value حيث أن رقم 1 هو العمود رقم 1 في الاكسل و هكذا strColumn1 = Trim(xlWs.Cells(intLine, 1).Value) strColumn2 = Trim(xlWs.Cells(intLine, 2).Value) strColumn3 = Trim(xlWs.Cells(intLine, 3).Value) تفضل التعديل Access-Import.accdb 4
محمد التميمي قام بنشر سبتمبر 19, 2021 قام بنشر سبتمبر 19, 2021 (معدل) 19 ساعات مضت, د.كاف يار said: @hassansaat تعلم الاستيراد بكل سهولة في البداية قم بإستدعاء مكتبة الإكسل الآن نقوم بإنشاء Module جديد و اضافة الكود التالي Public filenname As String Public Function importExcel(tablename As String) As String ', filenname As String Dim xlApp As Excel.Application Dim xlWb As Excel.Workbook Dim xlWs As Excel.Worksheet Dim intLine As Long Dim strSqlDml As String Dim strColumn1 As String, strColumn2 As String, strColumn3 As String varfile = filenname CurrentDb.Execute "DELETE * FROM List", dbFailOnError Set xlApp = New Excel.Application xlApp.Visible = False Set xlWb = xlApp.Workbooks.Open(varfile) Set xlWs = xlWb.Worksheets(1) intLine = 2 Do strColumn1 = Trim(xlWs.Cells(intLine, 1).Value) strColumn2 = Trim(xlWs.Cells(intLine, 2).Value) strColumn3 = Trim(xlWs.Cells(intLine, 3).Value) strSqlDml = "INSERT INTO List VALUES('" & strColumn1 & "', '" & strColumn2 & "', '" & strColumn3 & "')" CurrentDb.Execute strSqlDml, dbFailOnError xlWs.Cells(intLine, 1).Select intLine = intLine + 1 Loop Until IsEmpty(xlWs.Cells(intLine, 1)) xlWb.Close False xlApp.Quit Set xlApp = Nothing Set xlWb = Nothing Set xlWs = Nothing filenname = "" End Function Public Sub SelectFiles() Dim Addfile As Object Set Addfile = Application.FileDialog(3) With Addfile .AllowMultiSelect = False .InitialFileName = "" .Filters.Clear .Filters.Add "Excel Files", "*.xls,*.xlsx" If .Show = True Then filenname = Trim(.SelectedItems(1)) Else Exit Sub End If End With End Sub شرح مختصر للكود نقوم بالإعلان عن متغييرات تحمل اسماء مستعارة للأعمدة في ملف الإكسل مثلا strColumn1 -strColumn2 - strColumn3 Dim strColumn1 As String, strColumn2 As String, strColumn3 As String الأن نقوم بتعريف المتغييرات على الأعمدة في ملف الأكسل من خلال التعريف xlWs.Cells(intLine, 1).Value حيث أن رقم 1 هو العمود رقم 1 في الاكسل و هكذا strColumn1 = Trim(xlWs.Cells(intLine, 1).Value) strColumn2 = Trim(xlWs.Cells(intLine, 2).Value) strColumn3 = Trim(xlWs.Cells(intLine, 3).Value) السلام عليكم بارك الله بجهودك القيمة استاذي الكريم د.كاف يار الشكر كل الشكر لك بالمرور والمشاركة هل لي ان اعرف كيف السبيل الى استيراد بيانات من اكسل الى اكسس بوجود الترقيم التلقائي في جدول الاكسس وبطريقة صحيحة وامنة للبيانات ارجوا من جنابكم الكريم قراة مشاركتي للموضوع الاسبوع الفائت ( هل هذا الاجراء صحيح ) تم تعديل سبتمبر 19, 2021 بواسطه محمد التميمي
د.كاف يار قام بنشر سبتمبر 20, 2021 قام بنشر سبتمبر 20, 2021 8 ساعات مضت, محمد التميمي said: السلام عليكم بارك الله بجهودك القيمة استاذي الكريم د.كاف يار الشكر كل الشكر لك بالمرور والمشاركة هل لي ان اعرف كيف السبيل الى استيراد بيانات من اكسل الى اكسس بوجود الترقيم التلقائي في جدول الاكسس وبطريقة صحيحة وامنة للبيانات ارجوا من جنابكم الكريم قراة مشاركتي للموضوع الاسبوع الفائت ( هل هذا الاجراء صحيح ) ارفق رابط المشاركة المعنية
الردود الموصى بها
Join the conversation
You can post now and register later. If you have an account, sign in now to post with your account.