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

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

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

أريد جلب بيانات هذا الملف لجميع الشيتات الموجودة فيه . بحيث بيانات كل شيت تكون بالجدول الخاص بها . 

@kanory @jjafferr 

دمتم بخير 

 

 

جلب البيانات.rar

تم تعديل بواسطه فايز..
قام بنشر

وعليكم السلام استاذ فايز 🙂

 

استعملت استعلامات الحاق لكل جدول ، وهذا مثال للجدول sheet2 ، وعن واستخدمت معيار طول المعلومة Len حتى افرز المعلومات الغير مطلوبة (المسميات) :

image.png.f38dd5dd37acf042cd5e575bbc95a07b.png

 

والكود:

Private Sub Browse_Click()

    ' open the widows filw dialog to select the Excel file

    With Application.FileDialog(3)
        .Title = "Choose File"
        .Filters.Clear
        .Filters.Add "Excel Files", "*.xls ; *.xlsx"
        '.Filters.Add "Excel Files", "*.csv"
        .AllowMultiSelect = False
        .InitialFileName = ""
        If .Show = -1 Then
            Me.txtPath = .SelectedItems(1)
        End If
    End With

End Sub

Private Sub cmd_Selected_File_Click()
    
    ' import the Excel sheet
    
'1
    'Empty the temporary Table tabl1
    CurrentDb.Execute ("Delete * From tabl1")
    
'2
    'import Sheets to table tabl1, one at a time
    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 strPassword As String

    ' Establish an EXCEL application object
    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

    ' Change this next line to True if the first row in EXCEL worksheet
    ' has field names
    blnHasFieldNames = False


    strPathFile = Me.txtPath    ' "C:\Filename.xls"

    ' Replace tablename with the real name of the table into which
    ' the data are to be imported
    strTable = "tabl1" '"tablename"

    ' Replace passwordtext with the real password;
    ' if there is no password, replace it with vbNullString constant
    ' (e.g., strPassword = vbNullString)
    strPassword = vbNullString  '"passwordtext"

    blnReadOnly = True ' open EXCEL file in read-only mode

    ' Open the EXCEL file and read the worksheet names into a collection
    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

    ' Close the EXCEL file without saving the file, and clean up the EXCEL objects
    objWorkbook.Close False
    Set objWorkbook = Nothing
    If blnEXCEL = True Then objExcel.Quit
    Set objExcel = Nothing


'3
    ' Import the data from each worksheet into the table
    For lngCount = colWorksheets.Count To 1 Step -1
        DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel9, strTable, strPathFile, blnHasFieldNames, colWorksheets(lngCount) & "$"

'4
    'append the data using the proper query
    DoCmd.SetWarnings False
        DoCmd.OpenQuery "qry_" & lngCount
    DoCmd.SetWarnings True
    
'5
    'empty tbl_Sheets
    CurrentDb.Execute ("Delete * From tabl1")

Next_lngCount:
    Next lngCount

    ' Delete the collection
    Set colWorksheets = Nothing


' Uncomment out the next code step if you want to delete the
' EXCEL file after it's been imported
' Kill strPathFile

    MsgBox "Done"
    
End Sub

 

جعفر

1232.From_Excel_to_Access.accdb.zip

  • Like 2
  • Thanks 4
قام بنشر (معدل)

جزاك الله خيرا اخي  @jjafferr

وزوجك بنت الحلال تبرمجها على هواك .. 🌹🌹

سأطلع على الملف وابلغك النتيجة .. 

تم تعديل بواسطه jjafferr
حذف اقتباس المشاركة السابقة ، لتنظيف الموضوع
  • Haha 1
قام بنشر
13 دقائق مضت, فايز.. said:

وزوجك بنت الحلال تبرمجها على هواك .. 🌹🌹

همممم ، الظاهر اني اكلم صاحب خبرة ، ومنخش ومستحي :wavetowel:

  • Haha 1
قام بنشر
9 دقائق مضت, jjafferr said:

همممم ، الظاهر اني اكلم صاحب خبرة ، ومنخش ومستحي :wavetowel:

لا بالله اني موحد .. 🙋‍♀️

  • Haha 1
قام بنشر (معدل)
3 ساعات مضت, kanory said:

وهذا نفس الكود بدون استعلام أخي أستاذ @jjafferr

ومنكم اقتبسنا الكود :yes:

 

1232.From_Excel_to_Access.accdb.zip 32.27 kB · 1 تنزيلات

بارك الله فيك @kanory وجزاك كل خير .. أشكر لك مشاركتك .. وسأدعو لك بمثل ما دعوت به لعمدة حارتنا @jjafferr ( زوجك الله زوجة صالحة لها عينان عسليتان ) 🌹🌹🌹

## بعدين الحين ورطتني في الإشارة الى افضل اجابة .. 

تم تعديل بواسطه فايز..
  • Thanks 1
قام بنشر
منذ ساعه, فايز.. said:

بارك الله فيك @kanory وجزاك كل خير .. أشكر لك مشاركتك .. وسأدعو لك بمثل ما دعوت به لعمدة حارتنا @jjafferr ( زوجك الله زوجة صالحة لها عينان عسليتان ) 🌹🌹🌹

## بعدين الحين ورطتني في الإشارة الى افضل اجابة .. 

لا ورطتك ولا شيئ انا متبرع بالزوجة والاشارة كافضل اجابة للعمدة @jjafferr 

  • Like 1
قام بنشر

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

  • Like 2
قام بنشر

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

 

9 ساعات مضت, kanory said:

وهذا نفس الكود بدون استعلام أخي أستاذ @jjafferr

ملاحظتك خلتني اشوف شو السالفة 🙂

 

انا عادة ما احب اعمل اي تغيير على جداول المبرمج ، وخاصة في المنتدى ، لأنه معظم البرامج التي يرفقوها تكون جزء من كل ، فأي تغيير قد يؤثر على اشياء اخرى 🙂

ولكن ما يمنع اننا نعرض الافضل ، ويكون عند السائل الاختيار ، وهذا ما قمت به انت ، وعمل جميل 🙂

 

وللمقارنه ، ففي الاستعلامات اللي عملتها انا ، كنت افرز كل الكلمات واترك الارقام ، بواسطة المعيار ، عن طريق:

1.ان الحقل مو فارغ (طوله لا يساوي صفر) ، 2.طول المعلومة (يعني عدد حروفها)  وعرفت هذا بمعاينة وتحليل البيانات،

بينما قمت انت بعمل 1. في الجدول ، واذا اراد اخونا فايز ان يستخدم المعيار الآخر ، فهو كما في الصورة ادناه :

image.png.13ff825d27040751bea671ae4cc51ecf.png

.

6 ساعات مضت, فايز.. said:

بعدين الحين ورطتني في الإشارة الى افضل اجابة

بالعكس ، وبعد قراءة سؤالك من جديد ، اتضح ان البيانات اللي تستخرجها من برنامجي انا فيها تصفية ، والبيانات اللي تستخرجها من برنامج اخونا Kanory هي مطابقة لطلبك ، فمافي حيرة 🙂

 

5 ساعات مضت, kanory said:

انا متبرع بالزوجة والاشارة كافضل اجابة للعمدة

13 ساعات مضت, فايز.. said:
13 ساعات مضت, jjafferr said:

همممم ، الظاهر اني اكلم صاحب خبرة ، ومنخش ومستحي :wavetowel:

لا بالله اني موحد .. 🙋‍♀️

ها استاذ فايز ، صاروا اثنين ، وعندي وحدة ، ومن حقي الرابعة ، متى؟ 🙂

رجاء ثم رجاء ، لا تخلون زوجاتكم جنبكم لما تشاركون في المنتدى ، علشان تأخذون راحتكم ، يا موحدين (واقصد بتوحيدكم لله سبحانه وتعالى 🙂 )

 

جعفر

  • Haha 2
قام بنشر (معدل)
8 ساعات مضت, kanory said:

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

ما شاء الله تبارك الله .. 

ممتاز جدا وفكرة جميلة .. 

** لكن هناك الصفين الأولين لا أريد أن تظهر في الجدول . اللي هما الصفين اللي باللون الأزرق في المرفق في شيت رقم 1-2-3-4-5-6

 

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

بحثت وحاولت أجد لكن لم أصل إلى نتيجة .. 

@jjafferr @kanory 

‏‏‏‏StudentGuidance (1).xls

تم تعديل بواسطه فايز..
قام بنشر

لولا اني احبك استاذ @jjafferr يمكن كنت دعيت عليك ماهذا الكود لا حول ولا قوة الا بالله معقولة يمكن انت تتريك وتتغدى وتتعشى كودات

Private Sub Browse_Click()

    ' open the widows filw dialog to select the Excel file

    With Application.FileDialog(3)
        .Title = "Choose File"
        .Filters.Clear
        .Filters.Add "Excel Files", "*.xls ; *.xlsx"
        '.Filters.Add "Excel Files", "*.csv"
        .AllowMultiSelect = False
        .InitialFileName = ""
        If .Show = -1 Then
            Me.txtPath = .SelectedItems(1)
        End If
    End With

End Sub

Private Sub cmd_Selected_File_Click()
    
    ' import the Excel sheet
    
'1
    'Empty the temporary Table tabl1
    CurrentDb.Execute ("Delete * From tabl1")
    
'2
    'import Sheets to table tabl1, one at a time
    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 strPassword As String

    ' Establish an EXCEL application object
    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

    ' Change this next line to True if the first row in EXCEL worksheet
    ' has field names
    blnHasFieldNames = False


    strPathFile = Me.txtPath    ' "C:\Filename.xls"

    ' Replace tablename with the real name of the table into which
    ' the data are to be imported
    strTable = "tabl1" '"tablename"

    ' Replace passwordtext with the real password;
    ' if there is no password, replace it with vbNullString constant
    ' (e.g., strPassword = vbNullString)
    strPassword = vbNullString  '"passwordtext"

    blnReadOnly = True ' open EXCEL file in read-only mode

    ' Open the EXCEL file and read the worksheet names into a collection
    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

    ' Close the EXCEL file without saving the file, and clean up the EXCEL objects
    objWorkbook.Close False
    Set objWorkbook = Nothing
    If blnEXCEL = True Then objExcel.Quit
    Set objExcel = Nothing


'3
    ' Import the data from each worksheet into the table
    For lngCount = colWorksheets.Count To 1 Step -1
        DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel9, strTable, strPathFile, blnHasFieldNames, colWorksheets(lngCount) & "$"

'4
    'append the data using the proper query
    DoCmd.SetWarnings False
        DoCmd.OpenQuery "qry_" & lngCount
    DoCmd.SetWarnings True
    
'5
    'empty tbl_Sheets
    CurrentDb.Execute ("Delete * From tabl1")

Next_lngCount:
    Next lngCount

    ' Delete the collection
    Set colWorksheets = Nothing


' Uncomment out the next code step if you want to delete the
' EXCEL file after it's been imported
' Kill strPathFile

    MsgBox "Done"
    
End Sub

 على كلن جزاك الله كل خير 

قام بنشر

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

 

7 ساعات مضت, فايز.. said:

لكن هناك الصفين الأولين لا أريد أن تظهر في الجدول . اللي هما الصفين اللي باللون الأزرق في المرفق في شيت رقم 1-2-3-4-5-6

 

لأوراق الاكسل 2-6 هذا هو قصدي في ملاحظتي في مشاركتي السابقة ، يعني برنامجي يعطيك اللي تريده ، وبعمل التعديل يشتغل برنامج اخوي Kanory مثل برنامجي :

9 ساعات مضت, jjafferr said:

وللمقارنه ، ففي الاستعلامات اللي عملتها انا ، كنت افرز كل الكلمات واترك الارقام ، بواسطة المعيار ، عن طريق:

1.ان الحقل مو فارغ (طوله لا يساوي صفر) ، 2.طول المعلومة (يعني عدد حروفها)  وعرفت هذا بمعاينة وتحليل البيانات،

بينما قمت انت بعمل 1. في الجدول ، واذا اراد اخونا فايز ان يستخدم المعيار الآخر ، فهو كما في الصورة ادناه :

جرب برنامجي وشوف 🙂

اما الورقة الاولى ، فيمكنك في الاستعلام رقم 1 ، تحذف العمود اللي فيه f2 .

 

اما حذف بيانات الجدول قبل اضافة البيانات الجديدة ، فأضف السطر الثاني فقط الى الكود (هذه الاسطر من كود برنامجي ، انا اضفت لها السطر الثاني) :

    DoCmd.SetWarnings False
	CurrentDb.Execute ("Delete * From " & "qry_" & lngCount)
        DoCmd.OpenQuery "qry_" & lngCount
    DoCmd.SetWarnings True

 

جعفر

قام بنشر
16 دقائق مضت, ازهر عبد العزيز said:

1. لولا اني احبك استاذ @jjafferr يمكن كنت دعيت عليك !!

2. ماهذا الكود لا حول ولا قوة الا بالله

3. معقولة يمكن انت تتريك وتتغدى وتتعشى كودات

 

1. انا لازال عندي مجال انك تدعي عليّ بالزوجة الرابعة (زوجتي ، واثنين من الاستاذ فايز صاروا 3 وباقي لي الرابعة 🙂 )

2. في الواقع هذا الكود نسخ ولصق من احد ردودي لسنة 2015 ، ووجدت الكود على الانترنت في وقتها ، وما لقيت له صاحب معين علشان اكتب رابطه ، ولكن طبعا عملت عليه التعديلات علشان يناسب السؤال. 

3. رجاء ارجع للمادة 1 اعلاه :biggrin:

 

جعفر

  • Haha 1
قام بنشر (معدل)
38 دقائق مضت, jjafferr said:

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

 

 

لأوراق الاكسل 2-6 هذا هو قصدي في ملاحظتي في مشاركتي السابقة ، يعني برنامجي يعطيك اللي تريده ، وبعمل التعديل يشتغل برنامج اخوي Kanory مثل برنامجي :

جرب برنامجي وشوف 🙂

اما الورقة الاولى ، فيمكنك في الاستعلام رقم 1 ، تحذف العمود اللي فيه f1 .

 

اما حذف بيانات الجدول قبل اضافة البيانات الجديدة ، فأضف السطر الثاني فقط الى الكود (هذه الاسطر من كود برنامجي ، انا اضفت لها السطر الثاني) :


    DoCmd.SetWarnings False
	CurrentDb.Execute ("Delete * From " & "qry_" & lngCount)
        DoCmd.OpenQuery "qry_" & lngCount
    DoCmd.SetWarnings True

 

جعفر

 

اقتباس

لأوراق الاكسل 2-6 هذا هو قصدي في ملاحظتي في مشاركتي السابقة ، يعني برنامجي يعطيك اللي تريده ، وبعمل التعديل يشتغل برنامج اخوي Kanory مثل برنامجي :

ما فهمت عليك .. 

اقتباس

اما حذف بيانات الجدول قبل اضافة البيانات الجديدة ، فأضف السطر الثاني فقط الى الكود 

تم اضافة السطر الثاني فظهرت الرسالة 

image.png.505b4672436bd9fdf0ada1d2a415ab40.png

 

image.png.3c9ea913a20d9b7cd2b006e6a1991642.png

 

تم تعديل بواسطه فايز..
قام بنشر
2 دقائق مضت, فايز.. said:

ما فهمت عليك .. 

 

في احد مشاركاتي اعلاه ، انا ذكرت طلبك ، وخلني اوضحه زيادة:

استعلامات الإلحاق اللي عملتها انا في برنامجي ، لا تّدخل السطرين الاول والثاني في الجداول ، وعملت هذا بواسطة المعيار ، عن طريق:

1.ان الحقل مو فارغ (طوله لا يساوي صفر) ، 2.طول المعلومة (يعني عدد حروفها) وعرفت هذه المعلومات بمعاينة وتحليل البيانات،

بينما قام اخوي Kanory بعمل 1. في الجدول ، واذا ارادت ان تستخدم المعيار الآخر في الجدول كذلك ، فالطريقة كما في الصورة ادناه :

image.png.13ff825d27040751bea671ae4cc51ecf.png.

 

اما صورة الخطأ فلا استطيع قراءتها لصغر الرسالة (انت جرب ان تقرأها من الصورة اعلاه وشوف قصدي 🙂 ) ،

ومع الصورة الواضحة ، اريد اعرف على اي سطر يقف الكود (اعمل صورة من رسالة الخطأ ، ثم انقر على Debug وبتشوف ان سطر الكود لونه اصفر ، اريد صورة هذا كذلك)

 

جعفر

قام بنشر
4 دقائق مضت, jjafferr said:

 

في احد مشاركاتي اعلاه ، انا ذكرت طلبك ، وخلني اوضحه زيادة:

استعلامات الإلحاق اللي عملتها انا في برنامجي ، لا تّدخل السطرين الاول والثاني في الجداول ، وعملت هذا بواسطة المعيار ، عن طريق:

1.ان الحقل مو فارغ (طوله لا يساوي صفر) ، 2.طول المعلومة (يعني عدد حروفها) وعرفت هذه المعلومات بمعاينة وتحليل البيانات،

بينما قام اخوي Kanory بعمل 1. في الجدول ، واذا ارادت ان تستخدم المعيار الآخر في الجدول كذلك ، فالطريقة كما في الصورة ادناه :

image.png.13ff825d27040751bea671ae4cc51ecf.png.

 

اما صورة الخطأ فلا استطيع قراءتها لصغر الرسالة (انت جرب ان تقرأها من الصورة اعلاه وشوف قصدي 🙂 ) ،

ومع الصورة الواضحة ، اريد اعرف على اي سطر يقف الكود (اعمل صورة من رسالة الخطأ ، ثم انقر على Debug وبتشوف ان سطر الكود لونه اصفر ، اريد صورة هذا كذلك)

 

جعفر

الخطأ في هذا السطر 

	CurrentDb.Execute ("Delete * From " & "qry_" & lngCount)

 

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