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

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


إذهب إلى أفضل إجابة Solved by kanory,

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

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

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

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

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

image.png.0a92c6054e2098c40965027208da52dc.png

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

 

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

 

 

مثال1.xls

رابط هذا التعليق
شارك

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

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

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

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

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

image.png.0a92c6054e2098c40965027208da52dc.png

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

 

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

 

 

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

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

 

تم تعديل بواسطه kanory
  • Like 3
رابط هذا التعليق
شارك

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

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

 

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

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

 

 

 

 

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

  • أفضل إجابة
6 ساعات مضت, ولد جدة said:

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

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

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

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

 

‏‏import_kan2.accdb

  • Like 3
رابط هذا التعليق
شارك

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

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

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

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

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

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

رابط هذا التعليق
شارك

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

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

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

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

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

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

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

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

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

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

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

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

  • Like 4
رابط هذا التعليق
شارك

  • 2 months later...

الاستاذ kanory

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

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

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

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

مثال 2.xls

رابط هذا التعليق
شارك

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

 

تم تعديل بواسطه kanory
  • Like 4
رابط هذا التعليق
شارك

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