تصدير الى اكسيل مع الاجماليات

[jo_2010]

الخبراء الافاضل

بعد التحية

مارايدة موجود بالصورة هل هذا ممكن ام شئ صعب

JO.accdb

[Foksh]

وعليكم السلام أخي يوسف ..

تفضل ملفك بعد التعديل ، حيث تم استخدام الحدث التالي في الزر :-

Private Sub أمر0_Click()
    On Error GoTo ErrorHandler
    
    Dim db As DAO.Database
    Dim qdf As DAO.QueryDef
    Dim strSQL As String
    Dim strFileName As String
    Dim strFilePath As String
    Dim strQueryName As String
    
    strSQL = "SELECT Tcode, Tname, Out_Lab, IN_Lab, Total, IN_Staff, Total_Staff FROM (" & _
             "  SELECT 0 AS SortID, Tcode, Tname, Out_Lab, IN_Lab, Total, IN_Staff, Total_Staff FROM Tbl_Tests " & _
             "  UNION ALL " & _
             "  SELECT 1 AS SortID, '', 'المجموع الكلي', SUM(Out_Lab), SUM(IN_Lab), SUM(Total), SUM(IN_Staff), SUM(Total_Staff) FROM Tbl_Tests" & _
             ") " & _
             "ORDER BY SortID, Val(Tcode), Tcode;"
    
    strFileName = Format(Now, "yyyy-mm-dd_hh-nn-ss") & ".xlsx"
    strFilePath = CurrentProject.Path & "\" & strFileName
    
    strQueryName = "TempExportQuery"
    Set db = CurrentDb
    
    On Error Resume Next
    db.QueryDefs.Delete strQueryName
    On Error GoTo ErrorHandler
    
    Set qdf = db.CreateQueryDef(strQueryName, strSQL)
    
    DoCmd.OutputTo acOutputQuery, strQueryName, acFormatXLSX, strFilePath, False
    
    db.QueryDefs.Delete strQueryName
    
    MsgBox "تم تصدير البيانات بنجاح", vbInformation + vbMsgBoxRight, "تم التصدير"
    
ExitProcedure:
    Set qdf = Nothing
    Set db = Nothing
    Exit Sub

ErrorHandler:
    MsgBox "حدث خطأ أثناء عملية التصدير", vbCritical + vbMsgBoxRight, "خطأ"
    Resume ExitProcedure
End Sub

 

وسيتم انشاء ملف اكسل باسم = الوقت الحالي وتاريخ اليوم ، وتستطيع تغيير اسم الملف كما تريد .

JO.zip

[jo_2010]

شكر  خاص للخبير الفاضل Foksh

حاولت اطبق كود حضرتك على الاستعلام الحقيقى ولكتة لايعمل

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

JO_2.accdb

تم تعديل منذ 23 دقائق بواسطه jo_2010