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

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

ابو البشر

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

 مشاركة
إذهب إلى أفضل إجابة Solved by أبو إبراهيم الغامدي,

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

ابو البشر

ابو البشر

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

السلام عليكم ورحمة الله وبركاته ..... جميع اعضاء المنتدى ..... كل عام وانتم بخير وأسأل الله عز وجل أن يتقبل منا ومنكم صالح الاعمال

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

@فايز و @Barna و @jjafferr و @أبو إبراهيم الغامدي في هذا الموضوع ولدي عدد من الاستفسار على الكود التالي بارك الله فيكم : 

Option Compare Database
Option Explicit

Sub IMPORT_XLSDB()
   On Error GoTo SUB_CLOSE
   
   '-- OPEN CURRENT DATABASE AS LOCAL DB
   Dim DB As DAO.Database
   Set DB = CurrentDb
   '-- OPEN RS DB TO ADD DATA
   Dim DBRS As DAO.Recordset
   Set DBRS = CurrentDb.OpenRecordset("TABLE")
   
   '-- OPEN XLS FILE AS REMOTE DATABASE
   Dim XLDB  As DAO.Database
   Set XLDB = OpenDatabase( _
   CurrentProject.Path & "\CS_SeetNumberLabels2.xlsx", False, False, "EXCEL 12.0;HDR=NO;")
   '-- OPEN XLS SHEET AS REMOTE RS
   Dim XLRS As DAO.Recordset
   Dim RCROW()
   Dim RC As Long
   Dim I As Integer
   Dim TD As DAO.TableDef
   '-- LOOP THROUGH XLDB TABLES (SHEETS)
   For Each TD In XLDB.TableDefs
   '-----------------------------------------------------------------------------------------'
      '-- RECORDS FROM COLUMN (C) IN XL SHEET
      Set XLRS = XLDB.OpenRecordset("SELECT F1 FROM [" & TD.Name & "C:C]WHERE NOT ISNULL(F1)")
      '-- COUNT RECORDS
      XLRS.MoveLast: RC = XLRS.RecordCount: XLRS.MoveFirst
      '-- EACH 5 OF XLRS RECORDS MAKE 1 RECORD IN DBRS
      For I = 1 To RC Step 5
         RCROW = XLRS.GetRows(5)
         DBRS.AddNew
            DBRS![ACADEMIC YEAR] = RCROW(0, 0)
            DBRS![ACADEMIC NUM] = Mid(RCROW(0, 1), InStrRev(RCROW(0, 1), Chr(32)))
            DBRS![STNAME] = RCROW(0, 2)
            DBRS![F1] = RCROW(0, 3)
            DBRS![Sub] = RCROW(0, 4)
         DBRS.Update
      Next
      Set XLRS = Nothing
      '--------------------------------------------------------------------------------------'
      '-- RECORDS FROM COLUMN (I) IN XL SHEET
      Set XLRS = XLDB.OpenRecordset("SELECT F1 FROM [" & TD.Name & "I:I]WHERE NOT ISNULL(F1)")
      '-- COUNT RECORDS
      XLRS.MoveLast: RC = XLRS.RecordCount: XLRS.MoveFirst
      '-- EACH 5 OF XLRS RECORDS MAKE 1 RECORD IN DBRS
      For I = 1 To RC Step 5
         RCROW = XLRS.GetRows(5)
         DBRS.AddNew
            DBRS![ACADEMIC YEAR] = RCROW(0, 0)
            DBRS![ACADEMIC NUM] = Mid(RCROW(0, 1), InStrRev(RCROW(0, 1), Chr(32)))
            DBRS![STNAME] = RCROW(0, 2)
            DBRS![F1] = RCROW(0, 3)
            DBRS![Sub] = RCROW(0, 4)
         DBRS.Update
      Next
      Set XLRS = Nothing
   Next
SUB_CLOSE:
   '-- COLOSE XLDB AND XLRS
   Set XLRS = Nothing
'   XLDB.Close
   Set XLDB = Nothing
   '------------------------'
   '-- CLOSE DB AND DBRS
   Set DBRS = Nothing
   XLDB.Close
   Set XLDB = Nothing
End Sub

 

1- ما المقصود في الاؤقام المسجلة في 1 و 2

2- ما المقصود ب F1 و هل يمكن تغيير النطاق في 4 وكيف يتم ذلك لو اغترضنا أن ملف الاكسل نريد جلب بيانات اكثر من عامود في الصفحة الواحدة دون تكرار للكود كما فعلنا في الكود السابق بمعنى بجلب بيانات العمود C  والعمود I مباشرة أو حتى أكثر من عمودين ؟؟؟؟

بارك الله فيكم وفي علمكم ...

1.png

2.png

الموضوع هنا بارك الله فيكم 

في ١١‏/٤‏/٢٠٢٠ at 21:27, أبو إبراهيم الغامدي said:

السلام عليكم..

أرى أن حواراً ممتعا دار في هذه المشاركة مما أثار رغبتي في المشاركة.. 😀

أرجو أن تجدوا في هذه المشاركة شيئاً جديداً ومميزاً.. 🤩

سوف نتعامل مع مصنف أكسل كقاعدة بيانات  ولعمل ذلك نطبق الشفرة التالي  


'-- OPEN XLS FILE AS REMOTE DATABASE
Dim XLDB  As DAO.Database
Set XLDB = OpenDatabase( _
CurrentProject.Path & "\CS_SeetNumberLabels2.xlsx", False, False, "EXCEL 12.0;HDR=NO;")

عند فتح مصنف أكسل كقاعدة بيانات سوف تصبح أوراق البيانات كجداول بيانات في أكسس، ولكي نتحقق من ذلك نستخدم الغرض TableDefs لسرد أسماء الجداول (أوراق البيانات) 


'-- LOOP THROUGH XLDB TABLES (SHEETS)
For Each TD In XLDB.TableDefs
	TD.Name
Next

:: عند النظر إلى ورقة البيانات في مصنف البانات نجد البيانات محصورة في العمودين (C,I) والبيانات ليست متساوية الطول وبالتالي نحن بحاجة إلى جعل كل عمود جدول بيانات مستقل!

:: يوجد في مكون البيانات Recordset وظيفة اسمه Getrows تقوم بتجميع البيانات كمصفوفة بيانات يحدد طولها المستخدم حسب احتياجة.  ولكون البيانات الطالب في ورقة البيانات تتكون من 5 صفوف؛ وبناءُ عليه سوف نقوم بتجميع البيانات على هذا الأساس. لكن يجب أن نقوم بأخذ عدد السجلات في الجدول (ورقة البيانات) والذي هو بالتأكيد من مضاعفات الـ(5).

الوظيفة Getrows تقوم بأخذ المجموع التالية من السجلات عن اطلاقها مرة أخرى وبالتالي نحن بحاجة إلى دوارة بطول السجلات وتقوم بالقفز كل 5 سجلات، بمعنى (20/5).

:: نقوم بعد ذلك بتسجيل البيانات في جدول الطلاب من مصفوفة البيانات التي تعيدها Getrows.

:: سوف تدور الشفرة على جميع الجداول (أوراق البيانات) وتكرر جلب البيانات مرتين حسب أعمدة البيانات التي سبق الإشارة إليها. كما أنها تقوم بحذف الصفوف الفارغة عند جلب البيانات.

الشفرة التالية توضح المبدأ السابق وطريقة نقل البيانات.. 


'-- LOOP THROUGH XLDB TABLES (SHEETS)
For Each TD In XLDB.TableDefs
'-----------------------------------------------------------------------------------------'
'-- RECORDS FROM COLUMN (C) IN XL SHEET
Set XLRS = XLDB.OpenRecordset("SELECT F1 FROM [" & TD.Name & "C:C]WHERE NOT ISNULL(F1)")
'-- COUNT RECORDS
XLRS.MoveLast: RC = XLRS.RecordCount: XLRS.MoveFirst
'-- EACH 5 OF XLRS RECORDS MAKE 1 RECORD IN DBRS
For I = 1 To RC Step 5
RCROW = XLRS.GetRows(5)
DBRS.AddNew
  DBRS![ACADEMIC YEAR] = RCROW(0, 0)
  DBRS![ACADEMIC NUM] = Mid(RCROW(0, 1), InStrRev(RCROW(0, 1), Chr(32)))
  DBRS![STNAME] = RCROW(0, 2)
  DBRS![F1] = RCROW(0, 3)
  DBRS![Sub] = RCROW(0, 4)
DBRS.Update
Next
Set XLRS = Nothing
'--------------------------------------------------------------------------------------'
'-- RECORDS FROM COLUMN (I) IN XL SHEET
Set XLRS = XLDB.OpenRecordset("SELECT F1 FROM [" & TD.Name & "I:I]WHERE NOT ISNULL(F1)")
'-- COUNT RECORDS
XLRS.MoveLast: RC = XLRS.RecordCount: XLRS.MoveFirst
'-- EACH 5 OF XLRS RECORDS MAKE 1 RECORD IN DBRS
For I = 1 To RC Step 5
RCROW = XLRS.GetRows(5)
DBRS.AddNew
  DBRS![ACADEMIC YEAR] = RCROW(0, 0)
  DBRS![ACADEMIC NUM] = Mid(RCROW(0, 1), InStrRev(RCROW(0, 1), Chr(32)))
  DBRS![STNAME] = RCROW(0, 2)
  DBRS![F1] = RCROW(0, 3)
  DBRS![Sub] = RCROW(0, 4)
DBRS.Update
Next
Set XLRS = Nothing
Next

إليكم الشفرة كاملة 


Option Compare Database
Option Explicit

Sub IMPORT_XLSDB()
   On Error GoTo SUB_CLOSE
   
   '-- OPEN CURRENT DATABASE AS LOCAL DB
   Dim DB As DAO.Database
   Set DB = CurrentDb
   '-- OPEN RS DB TO ADD DATA
   Dim DBRS As DAO.Recordset
   Set DBRS = CurrentDb.OpenRecordset("TABLE")
   
   '-- OPEN XLS FILE AS REMOTE DATABASE
   Dim XLDB  As DAO.Database
   Set XLDB = OpenDatabase( _
   CurrentProject.Path & "\CS_SeetNumberLabels2.xlsx", False, False, "EXCEL 12.0;HDR=NO;")
   '-- OPEN XLS SHEET AS REMOTE RS
   Dim XLRS As DAO.Recordset
   Dim RCROW()
   Dim RC As Long
   Dim I As Integer
   Dim TD As DAO.TableDef
   '-- LOOP THROUGH XLDB TABLES (SHEETS)
   For Each TD In XLDB.TableDefs
   '-----------------------------------------------------------------------------------------'
      '-- RECORDS FROM COLUMN (C) IN XL SHEET
      Set XLRS = XLDB.OpenRecordset("SELECT F1 FROM [" & TD.Name & "C:C]WHERE NOT ISNULL(F1)")
      '-- COUNT RECORDS
      XLRS.MoveLast: RC = XLRS.RecordCount: XLRS.MoveFirst
      '-- EACH 5 OF XLRS RECORDS MAKE 1 RECORD IN DBRS
      For I = 1 To RC Step 5
         RCROW = XLRS.GetRows(5)
         DBRS.AddNew
            DBRS![ACADEMIC YEAR] = RCROW(0, 0)
            DBRS![ACADEMIC NUM] = Mid(RCROW(0, 1), InStrRev(RCROW(0, 1), Chr(32)))
            DBRS![STNAME] = RCROW(0, 2)
            DBRS![F1] = RCROW(0, 3)
            DBRS![Sub] = RCROW(0, 4)
         DBRS.Update
      Next
      Set XLRS = Nothing
      '--------------------------------------------------------------------------------------'
      '-- RECORDS FROM COLUMN (I) IN XL SHEET
      Set XLRS = XLDB.OpenRecordset("SELECT F1 FROM [" & TD.Name & "I:I]WHERE NOT ISNULL(F1)")
      '-- COUNT RECORDS
      XLRS.MoveLast: RC = XLRS.RecordCount: XLRS.MoveFirst
      '-- EACH 5 OF XLRS RECORDS MAKE 1 RECORD IN DBRS
      For I = 1 To RC Step 5
         RCROW = XLRS.GetRows(5)
         DBRS.AddNew
            DBRS![ACADEMIC YEAR] = RCROW(0, 0)
            DBRS![ACADEMIC NUM] = Mid(RCROW(0, 1), InStrRev(RCROW(0, 1), Chr(32)))
            DBRS![STNAME] = RCROW(0, 2)
            DBRS![F1] = RCROW(0, 3)
            DBRS![Sub] = RCROW(0, 4)
         DBRS.Update
      Next
      Set XLRS = Nothing
   Next
SUB_CLOSE:
   '-- COLOSE XLDB AND XLRS
   Set XLRS = Nothing
'   XLDB.Close
   Set XLDB = Nothing
   '------------------------'
   '-- CLOSE DB AND DBRS
   Set DBRS = Nothing
   XLDB.Close
   Set XLDB = Nothing
End Sub

 

وهذه هي المفرفقات التى تتضمن المثال...

 

CS_SeetNumberLabels2.xlsx 85.5 kB · 3 تنزيلات Posters.accdb 568 kB · 3 تنزيلات

 

  • Like 2
رابط هذا التعليق
شارك
  • أفضل إجابة
أبو إبراهيم الغامدي

أبو إبراهيم الغامدي

قام بنشر
  • أفضل إجابة
قام بنشر

أهلا بك @ابو البشر

1 ساعه مضت, ابو البشر said:

- ما المقصود في الاؤقام المسجلة في 1 و 2

2- ما المقصود ب F1 و هل يمكن تغيير النطاق في 4 وكيف يتم ذلك لو اغترضنا أن ملف الاكسل نريد جلب بيانات اكثر من عامود في الصفحة الواحدة دون تكرار للكود كما فعلنا في الكود السابق بمعنى بجلب بيانات العمود C  والعمود I مباشرة أو حتى أكثر من عمودين ؟؟؟؟

بارك الله فيكم وفي علمكم ...

1.png

2.png

 

بالنسبة للرقم (1): المنهج GetRows يعيد عدد من صفوف بيانات الجدول المشار إليه في المتغير الغرضي XLRS. والرقم بين القوسين يبين عدد الصفوف المطلوب إعادتها..

المنهج GetRows يعيد مصفوفة بيانات من حدين؛ الحد الأول يمثل رقم عمود البيانات (الحقل) في الجدول والثاني يمثل رقم الصف البيانات (السجل).. هذه الحدود يبدأ ترقيمها بالرقم 0

يجب اسناد المنهج GetRows إلى متغير مصفوفة بيانات عامة غير معينة الحدود.. وهو هنا RCROW؛ وهو المشار إليه بالرقم (2).  وكمثال (0,0)RCROW  يعيد قيمة العمود الأول من الصف  الأول في جدول البيانات.

بالنسبة للرقم (3) :عند تجهال أسماء أعمدة البيانات المستوردة من أكسل يقوم أكسس بوضع أسماء مزيفة تبدأ بـ (F1)؛ و (F) اختصار كلمة Field و(1) رقم عمود البيانات في أكسس..

إذا كانت ورقة البيانات في أكسل تحتوي على أسماء للأعمدة فيمكن تغيير ذلك من خصائص استيراد البيانات؛ إما على مستوى مصنف البيانات أو على مستوى ورقة بيانات محددة...

بالنسبة للرقم (4): يمكن الاستغناء عن المحدد، أو توسيع نطاقه.. لكن لا يمكن استخدام نطاقات متعددة في المجال الواحد..

 

أرجو أن يكون هذا التفسير واضحاً ومفهوماً .. 

  • Like 4
  • Thanks 2
رابط هذا التعليق
شارك
عفرنس

عفرنس

قام بنشر
قام بنشر
2 دقائق مضت, أبو إبراهيم الغامدي said:

أهلا بك @ابو البشر

بالنسبة للرقم (1): المنهج GetRows يعيد عدد من صفوف بيانات الجدول المشار إليه في المتغير الغرضي XLRS. والرقم بين القوسين يبين عدد الصفوف المطلوب إعادتها..

المنهج GetRows يعيد مصفوفة بيانات من حدين؛ الحد الأول يمثل رقم عمود البيانات (الحقل) في الجدول والثاني يمثل رقم الصف البيانات (السجل).. هذه الحدود يبدأ ترقيمها بالرقم 0

يجب اسناد المنهج GetRows إلى متغير مصفوفة بيانات عامة غير معينة الحدود.. وهو هنا RCROW؛ وهو المشار إليه بالرقم (2).  وكمثال (0,0)RCROW  يعيد قيمة العمود الأول من الصف  الأول في جدول البيانات.

بالنسبة للرقم (3) :عند تجهال أسماء أعمدة البيانات المستوردة من أكسل يقوم أكسس بوضع أسماء مزيفة تبدأ بـ (F1)؛ و (F) اختصار كلمة Field و(1) رقم عمود البيانات في أكسس..

إذا كانت ورقة البيانات في أكسل تحتوي على أسماء للأعمدة فيمكن تغيير ذلك من خصائص استيراد البيانات؛ إما على مستوى مصنف البيانات أو على مستوى ورقة بيانات محددة...

بالنسبة للرقم (4): يمكن الاستغناء عن المحدد، أو توسيع نطاقه.. لكن لا يمكن استخدام نطاقات متعددة في المجال الواحد..

 

أرجو أن يكون هذا التفسير واضحاً ومفهوماً .. 

ما شاء الله عليك .. كفيت ووفيت . .

  • Like 1
  • Thanks 1
رابط هذا التعليق
شارك
ابو البشر

ابو البشر

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

بارك الله فيك أستاذي عبدالعزيز @أبو إبراهيم الغامدي وكتب الله أجرك وأثابك ...... تقبل الله منا ومنكم صالح الاعمال .....

الان اصبحت العملية مفهومه ..... شكرا لك ولجميع أعضاء المنتدى المبارك :signthankspin: :fff:

  • Like 2
  • Thanks 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