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

شرح كود تصدير بيانات الى اكسيل وتعديل استعلام وسبب عد ترحيل كل البيانات للاكسيل


abouelhassan

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

السلام عليكم اخوانى الافاضل

كل عام وحضراتكم بخير

احتاج شرح كود تصدير بيانات التصفية للاكسيل

On Error Resume Next

If IsNull(FromDate) Or IsNull(ToDate) Then
    MsgBox "íÌÈ ÇÎÊíÇÑ äØÇÞ ÇáÊÇÑíÎ ÇæáÇð", vbCritical + vbMsgBoxRight, "ÊäÈíå"
Else

        Dim MyFile As String
        DstFile = CurrentProject.Path & "\" & "File1.xlsm"
        Dim xlApp                   As Excel.Application
        Dim xlWb                    As Excel.Workbook
        Dim xlWs                    As Excel.Worksheet
        Dim db                      As DAO.Database
        Dim rs                      As DAO.Recordset
        Dim x                       As Integer
            x = 1
        DoCmd.SetWarnings False
        DoCmd.RunSQL "DELETE FROM Report1;"
        DoCmd.OpenQuery "Query1"
        DoCmd.SetWarnings True
        
        Set xlApp = New Excel.Application
            xlApp.Visible = False
        
        Set xlWb = xlApp.Workbooks.Open(DstFile)
        Set xlWs = xlWb.Worksheets(1)
        Set rs = CurrentDb.OpenRecordset("Report1")
        MsgBox rs.Fields(0)
        If Not rs.BOF And Not rs.EOF Then
            rs.MoveFirst
            While (Not rs.EOF)
            x = x + 1
             xlWs.Cells(x, 1).Value = rs.Fields(0)
             xlWs.Cells(x, 2).Value = rs.Fields(1)
             xlWs.Cells(x, 3).Value = rs.Fields(2)
             xlWs.Cells(x, 4).Value = rs.Fields(3)
             xlWs.Cells(x, 5).Value = rs.Fields(4)
             xlWs.Cells(x, 6).Value = rs.Fields(5)
             xlWs.Cells(x, 7).Value = rs.Fields(6)
             xlWs.Cells(x, 8).Value = rs.Fields(7)
             xlWs.Cells(x, 9).Value = rs.Fields(8)
             xlWs.Cells(x, 10).Value = rs.Fields(9)
             xlWs.Cells(x, 11).Value = rs.Fields(10)
             xlWs.Cells(x, 12).Value = rs.Fields(11)
             xlWs.Cells(x, 13).Value = rs.Fields(12)
             xlWs.Cells(x, 14).Value = rs.Fields(13)

                rs.MoveNext
            Wend
        End If
        Kill CurrentProject.Path & "\" & "ãáÎÕ ÇáÍÓÇÈÇÊ" & ".xlsm"
        xlWb.SaveAs CurrentProject.Path & "\" & "ãáÎÕ ÇáÍÓÇÈÇÊ" & ".xlsm"
        xlWb.Close False
        xlApp.Quit
        
        Set xlApp = Nothing
        Set xlWb = Nothing
        Set xlWs = Nothing
        If MsgBox("Êã ÇáÊÕÏíÑ ÈäÌÇÍ" & vbNewLine & vbNewLine & _
            " åá ÊÑíÏ ÚÑÖ ÇáãáÝ ¿", vbInformation + vbYesNo + vbMsgBoxRight, "ÊÃßíÏ") = vbYes Then
            Application.FollowHyperlink (CurrentProject.Path & "\" & "ãáÎÕ ÇáÍÓÇÈÇÊ" & ".xlsm"), , True
        
        End If
End If

لدى نموذج اسمه Form1 به فلتر ب نوع الحساب وكل الموجود بالصورة

2.png.5883f612c9d729e5a64f04cb440269c0.png

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

كل الفلترة يتم تصدير ناتج الفلترة الى الاكسيل تمام وبسرعة عدا فلترة حالة الصرف يتم تصدير كل البيانات كأن لم يكن فلتر لايتم تصدير ناتج الفلترة على النموذج

الاستعلام المسئول عن التصديرQueryForExport

هو ما احتاج سبب عدم تصدير ناتج الفلترة اليه المعيار المسئول عن حالة الصرف اسمه Pay

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

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

 

 

t1.rar

تم تعديل بواسطه abouelhassan
رابط هذا التعليق
شارك

هذه المتغييرات للإعلان عن ان المكتبة المستخدم هي الاكسل
نوع التطبيق  - الصفحة - الورقة
        Dim xlApp                   As Excel.Application  ' التطبيق
        Dim xlWb                    As Excel.Workbook    ' الملف
        Dim xlWs                    As Excel.Worksheet  ' الورقة

 

بعد الاعلان عن المتغييرات كإجراءات بإننا سوف نقوم باستخدام وظيفة محددة

يجب تزويد المكتبة او الوظيفة ببعض المعطيات كمسار ملف الاكسل

        Set xlWb = xlApp.Workbooks.Open("مسار ملف الاكسل")
        Set xlWs = xlWb.Worksheets(1)  ' رقم الورقة داخل ملف الاكسل

 

بعد فتح الملف الآن ما ذا تريد ان تفعل من خلال التالي تستطيع التعامل مع الخلية داخل الورقة

x= رقم السطر
y= رقم العمود
xlWs.Cells(x, Y).Value

التطبيق
xlWs.Cells(1, 1).Value

هذا باختصار شرح اساسيات الكود

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

والله استاذى د.كاف يارحضرتك طوق نجاة بالنسبة لى والله انا غريق

اشكرك جداااااااااااااااا ربى يحفظك ويرزقك كل خير يارب

باختصار استاذى هذا الكود من ابداعات حضرتك وهو سريع جدا بشرط وضع ملف الاكسيل بجانب قاعدة البيانات وهذا لايضايقنى بل ممتاز نفذت التعديلات بالجدول وكود الفلترة بالفورمForm1

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

احتاج تعديل بالاستعلام المسئول عن تصدير البيانات لتصدير البيانات بمعيار حالة الصرف مثل ما يصدر البيانات لكل انواع التصفية

بارك الله فيك استاذى الحبيب لقلبى والله

 

T1 (2).rar

تم تعديل بواسطه abouelhassan
رابط هذا التعليق
شارك

في 12‏/4‏/2022 at 19:10, abouelhassan said:

والله استاذى د.كاف يارحضرتك طوق نجاة بالنسبة لى والله انا غريق

اشكرك جداااااااااااااااا ربى يحفظك ويرزقك كل خير يارب

باختصار استاذى هذا الكود من ابداعات حضرتك وهو سريع جدا بشرط وضع ملف الاكسيل بجانب قاعدة البيانات وهذا لايضايقنى بل ممتاز نفذت التعديلات بالجدول وكود الفلترة بالفورمForm1

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

احتاج تعديل بالاستعلام المسئول عن تصدير البيانات لتصدير البيانات بمعيار حالة الصرف مثل ما يصدر البيانات لكل انواع التصفية

بارك الله فيك استاذى الحبيب لقلبى والله

 

T1 (2).rar 143.81 kB · 4 downloads

للرفع رفع الله قدركم

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

في 12‏/4‏/2022 at 15:19, د.كاف يار said:
هذه المتغييرات للإعلان عن ان المكتبة المستخدم هي الاكسل
نوع التطبيق  - الصفحة - الورقة
        Dim xlApp                   As Excel.Application  ' التطبيق
        Dim xlWb                    As Excel.Workbook    ' الملف
        Dim xlWs                    As Excel.Worksheet  ' الورقة

 

بعد الاعلان عن المتغييرات كإجراءات بإننا سوف نقوم باستخدام وظيفة محددة

يجب تزويد المكتبة او الوظيفة ببعض المعطيات كمسار ملف الاكسل

        Set xlWb = xlApp.Workbooks.Open("مسار ملف الاكسل")
        Set xlWs = xlWb.Worksheets(1)  ' رقم الورقة داخل ملف الاكسل

 

بعد فتح الملف الآن ما ذا تريد ان تفعل من خلال التالي تستطيع التعامل مع الخلية داخل الورقة

x= رقم السطر
y= رقم العمود
xlWs.Cells(x, Y).Value

التطبيق
xlWs.Cells(1, 1).Value

هذا باختصار شرح اساسيات الكود

للرفع @د.كاف ياررفع الله قدرك اخى 

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

  • 2 weeks later...
في 12‏/4‏/2022 at 19:10, abouelhassan said:

والله استاذى د.كاف يارحضرتك طوق نجاة بالنسبة لى والله انا غريق

اشكرك جداااااااااااااااا ربى يحفظك ويرزقك كل خير يارب

باختصار استاذى هذا الكود من ابداعات حضرتك وهو سريع جدا بشرط وضع ملف الاكسيل بجانب قاعدة البيانات وهذا لايضايقنى بل ممتاز نفذت التعديلات بالجدول وكود الفلترة بالفورمForm1

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

احتاج تعديل بالاستعلام المسئول عن تصدير البيانات لتصدير البيانات بمعيار حالة الصرف مثل ما يصدر البيانات لكل انواع التصفية

بارك الله فيك استاذى الحبيب لقلبى والله

 

T1 (2).rar 143.81 kB · 34 downloads

@د.كاف يار للرفع رفع الله قدركم

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

من فضلك سجل دخول لتتمكن من التعليق

ستتمكن من اضافه تعليقات بعد التسجيل



سجل دخولك الان
  • تصفح هذا الموضوع مؤخراً   0 اعضاء متواجدين الان

    • لايوجد اعضاء مسجلون يتصفحون هذه الصفحه
×
×
  • اضف...

Important Information