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

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

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

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

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

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

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

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

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