تصدير عدة استعلامات الى ملف اكسل كل استعلام فى ورقة عمل محددة

[SAROOK]

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

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

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

حاولت ان اقوم بالتعديل ولكن  قدر الله وماشاء فعل . مرفق القاعدة مع ملف الاكسل المذكور

تحياتي 

التصدير الى ملف اكسل معد مسبقا.rar

[ابو البشر]

49 دقائق مضت, SAROOK said:

حاولت ان اقوم بالتعديل ولكن  قدر الله وماشاء فعل . مرفق القاعدة مع ملف الاكسل المذكور

اذا كنت مصر على طريقتك تفضل التعديل ....

Function Export_Excel_officena_by_aba_judy(sXlsFile As String, sQuery As String, WrSht As Integer)
    Dim oExcel          As Object
    Dim oExcelWrkBk     As Object
    Dim oExcelWrSht     As Object
    Dim bExcelOpened    As Boolean
    Dim db              As DAO.Database
    Dim rs              As DAO.Recordset
    Dim iCols           As Integer
    Const xlCenter = -4108

    On Error Resume Next
    Set oExcel = GetObject(, "Excel.Application")
    If Err.Number <> 0 Then
        Err.Clear
        On Error GoTo Error_Handler
        Set oExcel = CreateObject("excel.application")
        bExcelOpened = False
    Else
        bExcelOpened = True
    End If
    On Error GoTo Error_Handler
    oExcel.ScreenUpdating = False
    oExcel.Visible = True
    Set oExcelWrkBk = oExcel.Workbooks.Open(sXlsFile)
    DoEvents
    Set oExcelWrSht = oExcelWrkBk.Sheets(WrSht)
    oExcelWrSht.Activate

    
    Set db = CurrentDb
    Set rs = db.OpenRecordset(sQuery, dbOpenSnapshot)
    With rs
        If .RecordCount <> 0 Then
            .MoveFirst
            


            oExcelWrSht.Range("f2").Value = "List Of New Monthly subscription( K4 )"
            oExcelWrSht.Range("j2").Value = Format(Date, "mmmm\.yyyy")
            oExcelWrSht.Range("f6").CopyFromRecordset rs
            oExcelWrSht.Range("f6").Select
            oExcelWrSht.Range("f1").Select
            
        Else
            MsgBox "There are no records returned by the specified queries/SQL statement.", vbCritical + vbOKOnly, "No data to generate an Excel spreadsheet with"
            GoTo Error_Handler_Exit
        End If
    End With


Error_Handler_Exit:
    On Error Resume Next
    oExcel.Visible = True
    rs.Close
    Set rs = Nothing
    Set db = Nothing
    Set oExcelWrSht = Nothing
    Set oExcelWrkBk = Nothing
    oExcel.ScreenUpdating = True
    Set oExcel = Nothing
    Exit Function

Error_Handler:
    MsgBox "The following error has occured" & vbCrLf & vbCrLf & _
           "Error Number: " & Err.Number & vbCrLf & _
           "Error Source: Export_Excel_officena_by_aba_judy" & vbCrLf & _
           "Error Description: " & Err.Description _
           , vbOKOnly + vbCritical, "An Error has Occured!"
    Resume Error_Handler_Exit
End Function

استدعيها بهذا الشكل في النموذج مع تعديل الرقم حسب رقم الشيت لديك ... 

    Dim sXlsFile As String
    
    sXlsFile = CurrentProject.Path & "\K6_Ded.xlsx"
    Call Export_Excel_officena_by_aba_judy(sXlsFile, "SELECT * FROM qry_Ded_K4_New_Excel", 1)
قم بتعديل الرقم 1 الى ارقام الشيت لديك

 

[ابو البشر]

كيف لو كانت بهذه الصورة ؟؟؟؟؟؟

 

تم تعديل April 20 بواسطه ابو البشر

[SAROOK]

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

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

بالنسبة  لهذه الطريقة فاسبابها هو ان يكون كل تقارير الاستعلامات  في ملف اكسل واحد بدلا من  ان كل تقرير استعلام في ملف اكسل لوحده فمثلا لو كان لدي 12 استعلام فبالمقابل سوف يكون بالضرورة لدي 12 ملف اكسل 

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

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

واخيرا اسال هل هناك كود يمنع حفظ  النتائج المعروضة في ملف الاكسل بعد ظهوره في ملف الاكسل بحيث انه بعد اغلاق ملف الاكسل يبقى ملف الاكسل فارغ 

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

تحياتي  

[ابو البشر]

6 دقائق مضت, SAROOK said:

واخيرا اسال هل هناك كود يمنع حفظ  النتائج المعروضة في ملف الاكسل بعد ظهوره في ملف الاكسل بحيث انه بعد اغلاق ملف الاكسل يبقى ملف الاكسل فارغ 

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

يعني انت لا تريد حفظ ملف الاكسل ... تريد فقط العرض

[SAROOK]

نعم اخي الكريم 

[ابو البشر]

اذا ما هو الداعي لتصديره للاكسل ؟؟؟ حتى نستطيع المساعدة

[SAROOK]

تمام .

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

الحفظ هنا سوف يكون لهذا الورقة التي تحوي الاستعلام المطلوب  في ملف منفصل باسم منفصل

اما هذا الملف فسيكون مثل مااسلفت ابشمهندس هو  مسودة 

كمثال هنا ناخد موظفي الاجازة بدون مرتب  

هؤلاء الموظفين بياناتهم متغيرة من شهر لاخر  . عند طلب استعلام عنهم للشهر الفلاني في ورقة عمل معينة وابقاء هذا النتائج مخزنة  وبعد فترة طلب استعلام اخر عنهم سوف نضطر لمسح بيانات الشهر الفلاني قبلا ثم ننفذ الاستعلام الجديد على ورقة خالية من البيانات  

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

ارجو ان اكون احسنت الشرح 

تحياتي لشخصك الكريم 

تم تعديل April 20 بواسطه SAROOK

[ابو البشر]

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

[ابو البشر]

تم التعديل على الفورم1 ...... جرب واعلمنا

 

Desktop.rar

[SAROOK]

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