مساعدة في الاستيراد من الاكسيل للاكسيس

[ولد جدة]

ارجو مساعدتي في الاستيراد من الاكسيل الي الاكسيس

حيث الملف يوجد به خلايا مدمجة

بحيث ارغب انه يضاف ثلاث حقول للجدول بحسب (الجهة - الخدمة الرئيسية - الخدمة الفرعيه( علما انه الخدمة الفرعيه ليست في جميع الخدمات )

بحيث تقريبا يكون الجدول بالشكل التالي

مرفق ملف الاكسيل

 

ولكم جزيل الشكر

 

 

مثال1.xls

[kanory]

في ٢٦‏/٥‏/٢٠٢١ at 11:07, ولد جدة said:

ارجو مساعدتي في الاستيراد من الاكسيل الي الاكسيس

حيث الملف يوجد به خلايا مدمجة

بحيث ارغب انه يضاف ثلاث حقول للجدول بحسب (الجهة - الخدمة الرئيسية - الخدمة الفرعيه( علما انه الخدمة الفرعيه ليست في جميع الخدمات )

بحيث تقريبا يكون الجدول بالشكل التالي

مرفق ملف الاكسيل

 

ولكم جزيل الشكر

 

 

مثال1.xls 38 kB · 5 downloads

ولد جدة ام الرخا والشدة .... اين ملف الاكسس المراد استيراد البيانات لها ؟؟؟؟؟

 

تم تعديل مايو 29, 2021 بواسطه kanory

[kanory]

هل هذا التصور المطلوب ؟؟؟؟

 

[ولد جدة]

هلا حياك الله اخوي kanory

يعطيك الف عافيه ايه نعم هذا التصور المطلوب في الاستيراد 

تسلم الله يسعدك اذا امكن توضيح طريقه الاستيراد 

[د.كاف يار]

اخي الكريم هذه مشاركة مع زملائي

دعنا نتعلم كيف يتم استيراد ملف اكسل بأسهل الطرق

 

    أولا / نحتاج لفتح مربع تحرير لإختيار ملف الإكسل من الكمبوتر و حفظ مساره

Dim Addfile As Object
Dim filepath As String
On Error GoTo errorhandle
Set Addfile = Application.FileDialog(3)
With Addfile ' فتح مربع التحرير لإختيار الملف
  .AllowMultiSelect = False
  .InitialFileName = ""
  .Filters.Clear
  .Filters.Add "All Files", "*.*"
  If .Show = True Then
      ' هنا تم تحديد الملف من مربع التحرير
      filepath = Trim(.SelectedItems(1)) ' مسار الملف
      
'===================================
'''''' استيراد الملف بعد التحديد''''''
'===================================

	DoCmd.TransferSpreadsheet acImport, 10, "اسم الجدول", filepath, False, ""
		MsgBox "تم الاستيراد بنجاح", vbOKOnly + vbMsgBoxRight, "تأكيد"

      Else
      Exit Sub
  End If
End With

errorhandleexit:
        Exit Sub
errorhandle:
        MsgBox Err.Description
        Resume errorhandleexit

 

 

 

 

[kanory]

6 ساعات مضت, ولد جدة said:

هلا حياك الله اخوي kanory

يعطيك الف عافيه ايه نعم هذا التصور المطلوب في الاستيراد 

تسلم الله يسعدك اذا امكن توضيح طريقه الاستيراد 

طيب جرب المرفق واعلمنا بالنتيجة ....

 

‏‏import_kan2.accdb

[ولد جدة]

جزاك الله الف خير اخوي kanory

النتيجة جدا رائعة ودقيقه 

وماشاء جدا جدا سريع في الاستيراد ..

طلب لاهنت الله يسعدك اذا امكن ووقت يسمح ..

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

ولك جزاك الشكر والتقدير وبارك الله في علمك وعملك ..

[kanory]

1 ساعه مضت, ولد جدة said:

جزاك الله الف خير اخوي kanory

النتيجة جدا رائعة ودقيقه 

وماشاء جدا جدا سريع في الاستيراد ..

واياك اخي الكريم ....

بارك الله فيك ....

1 ساعه مضت, ولد جدة said:

طلب لاهنت الله يسعدك اذا امكن ووقت يسمح ..

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

ولك جزاك الشكر والتقدير وبارك الله في علمك وعملك ..

المشكلة لديك ليس في الاستيراد ... لأن طريقة الاستيراد التي في البرنامج تصلح لاستيراد اي ملف اكسل ,,,

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

[Barna]

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

طيب جرب المرفق واعلمنا بالنتيجة ....

 

‏‏import_kan2.accdb 516 kB · 3 downloads

ما شاء الله تبارك الله ... الله ينور عليك أخي @kanory تفكير رائع ...

تم تعديل مايو 31, 2021 بواسطه Barna

[ولد جدة]

الاستاذ kanory

السلام عليكم ورحمة الله وبركاته ..

الله يعطيك العافيه احتجت استورد من ملف اخر مختلف قليل في البنيه وعدلت على الكود للاستيراد وللاسف لم تضبط معي 

اذا امكن التعديل علي الاستيراد علي الملف المرفق 

واذا امكن التوضيح في تعديل الكود ليسهل التعديل عند الحاجة ولك جزيل الشكر

مثال 2.xls

[kanory]

4 ساعات مضت, ولد جدة said:

الاستاذ kanory

السلام عليكم ورحمة الله وبركاته ..

الله يعطيك العافيه احتجت استورد من ملف اخر مختلف قليل في البنيه وعدلت على الكود للاستيراد وللاسف لم تضبط معي 

اذا امكن التعديل علي الاستيراد علي الملف المرفق 

واذا امكن التوضيح في تعديل الكود ليسهل التعديل عند الحاجة ولك جزيل الشكر

مثال 2.xls 58.5 kB · 1 download

استخدم هذا الفانك ولاحظ التغيرات وحاول فهم التعديل ......

Function kanory1()
On Error Resume Next
  Dim RSB As DAO.Recordset
  Dim RSD As DAO.Recordset
  Dim RSJ As DAO.Recordset
  Set RSB = CurrentDb.OpenRecordset("tblTempS", 2)
  Set RSD = CurrentDb.OpenRecordset("tblTempe", 2)
  Set RSJ = CurrentDb.OpenRecordset("tblTempS", 2)
  Dim I As Integer ', ClassDay As String, BM
   RSB.MoveLast
    RSB.Edit
    RSB!F24 = "الجهة"
    RSB.Update
   RSB.MoveFirst
'+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
  Do Until RSB.EOF
see:
    If RSB!F24 Like "*الجهة*" Then
        g = RSB!f7
'    ElseIf RSB!F20 Like "*الخدمة الرئيسية*" Then
'        t = RSB!f5
'   ElseIf RSB!F20 Like "*الخدمة الفرعية*" Then
'        s = RSB!f6
    End If
RSB.MoveNext
If RSB!F24 Like "*الجهة*" Then GoTo se
Loop
'++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
se:
Do Until RSJ.EOF
If IsNumeric(RSJ!F25) Then
RSD.AddNew
    RSD!f3 = RSJ!F2
    RSD!f4 = RSJ!F25
    RSD!f5 = RSJ!F22
    RSD!F6 = RSJ!F18
    RSD!f7 = RSJ!F16
    RSD!F8 = RSJ!f14
    RSD!F9 = RSJ!F13
    RSD!F10 = RSJ!F10
    RSD!f11 = RSJ!F8
    RSD!f12 = RSJ!F6
    RSD!f1 = g
'    RSD!F2 = t
'    RSD!f3 = s
RSD.Update
 End If
RSJ.MoveNext
If RSJ!F24 Like "*الجهة*" Then
    g = ""
    t = ""
    s = ""
    GoTo see
End If
 Loop
DoCmd.OpenTable "tblTempe"
DoCmd.Close acForm, "frmdrjat"
End Function

 

تم تعديل أغسطس 13, 2021 بواسطه kanory

[ولد جدة]

يعطيك الف عافيه استاذي ماقصرت ..

ضبط معي 

وجاري محاوله فهم التعديلات

جزاك الله الف خير