open_report_smart شخابيط وأفكار و حلول : إدارة عرض و طباعة التقارير الاحترافية - OpenReportSmart

[ابو جودي]

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

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

الخصائص والمميزات

• تحقق تلقائي من وجود التقرير قبل عرضه
• دعم التصفية من خلال تمرير شروط WhereCondition لتحديد البيانات
• ادارة المصدر وذلك من خلال استخراج RecordSource بشكل ديناميكي مع التخزين المؤقت داخل قاموس
• مرونة التعامل مع اوضاع التقارير المختلفه بحيث يدعم الطباعة - المعاينة - او اى وضع عرض
• الصمت المطلق للاستخدامات البرمجية من خلال اختيار تفعيل الوضع "بدون رسائل" للاستخدام البرمجى عند الحاجة بدون ازعاج
• استجابة ذكية ومعالجة اخطاء احترافية من خلال تعامل متكامل مع الأخطاء الشائعة تقريبا

 

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

• ضع  الكود فى وحدة نمطية عامة مثلا باسم :  basReportUtils
• استدعِ الدالة OpenReportSmart كما يناسب سيناريو العرض الذى تفضلة او المعالحة التى ترغب بها
• يمكن تمرير المعلمات بسهولة أو الاعتماد على القيم الافتراضية المستخدمة فى التكويد 

وأخيرا الكود المستخدم داخل الوحدة النمطية : basReportUtils

'            __
'           / /\
'          / /  \www.officena.net™
'         / /    \__________
'        / /      \        /\
'       /_/        \      / /
'    ___\ \      ___\____/_/_
'   /____\ \    /___________/\
'   \     \ \   \           \ \
'    \     \ \   \____       \ \
'     \     \ \  /   /\       \ \
'      \   / \_\/   / /        \ \
'       \ /        / /__________\/
'        /        / /     /
'       /ابو جودى/ /     /
'      /________/ /\    / 21/07/2025
'      \________\/\ \  / منتديات أوفيسنا عالم من الابداع
'                  \_\/_____________________________________
Option Compare Database
Option Explicit


'' ==== متغير خاص لتخزين مؤقت لمصادر البيانات ====
' --- Dictionary لتخزين RecordSource للتقارير
Private m_dictRecordSource As Object

'' ==== دالة: التحقق من وجود تقرير داخل قاعدة البيانات ====
Private Function ReportExists(ByVal strReportName As String) As Boolean
    On Error Resume Next
    ReportExists = Not CurrentProject.AllReports(strReportName) Is Nothing
    On Error GoTo 0
End Function

'' ==== دالة: الحصول على مصدر البيانات لتقرير معين مع تخزين مؤقت ====
Private Function GetRecordSource(ByVal strReportName As String) As String
    If m_dictRecordSource Is Nothing Then
        Set m_dictRecordSource = CreateObject("Scripting.Dictionary")
    End If

    If m_dictRecordSource.Exists(strReportName) Then
        GetRecordSource = m_dictRecordSource(strReportName)
        Exit Function
    End If

    On Error GoTo ErrHandler
    DoCmd.OpenReport strReportName, acDesign, , , acHidden
    GetRecordSource = Trim(Reports(strReportName).RecordSource)
    DoCmd.Close acReport, strReportName, acSaveNo
    m_dictRecordSource.Add strReportName, GetRecordSource
    Exit Function

ErrHandler:
    GetRecordSource = ""
End Function

'' ==== دالة: التحقق من احتواء التقرير على بيانات ====
Private Function ReportHasData(ByVal strReportName As String, ByVal strRecordSource As String, _
                              Optional ByVal strWhereCondition As String = "", _
                              Optional ByVal strOpenArgs As String = "") As Boolean
    Dim dbs As DAO.Database
    Dim rst As DAO.Recordset
    Dim qdf As DAO.QueryDef
    Dim lngCount As Long
    Dim bolIsQuery As Boolean

    On Error GoTo ErrHandler
    Set dbs = CurrentDb

    ''----  التحقق مما إذا كان strRecordSource يشير إلى استعلام محفوظ
    On Error Resume Next
    Set qdf = dbs.QueryDefs(strRecordSource)
    If Err.Number = 0 Then
        bolIsQuery = True
    Else
        Err.Clear
        bolIsQuery = False
    End If
    On Error GoTo ErrHandler

    ''----  محاولة حساب عدد السجلات
    If bolIsQuery Or InStr(1, strRecordSource, "SELECT", vbTextCompare) = 1 Then
        On Error Resume Next
        If bolIsQuery Then
            ''----  إذا كان استعلامًا محفوظًا، تحقق من المعلمات
            If qdf.Parameters.Count > 0 Then
                ReportHasData = False ' لا يمكن معالجة معلمات بدون قيم
                GoTo CleanUp
            End If
            Set rst = qdf.OpenRecordset(dbOpenSnapshot, dbReadOnly)
        Else
            ''----  إنشاء استعلام مؤقت مع strWhereCondition
            Dim strSQL As String
            strSQL = strRecordSource
            If Len(strWhereCondition) > 0 Then
                strSQL = strSQL & " WHERE " & strWhereCondition
            End If
            Set rst = dbs.OpenRecordset(strSQL, dbOpenSnapshot, dbReadOnly)
        End If
        If Err.Number = 0 Then
            lngCount = IIf(rst.EOF, 0, rst.RecordCount)
            rst.Close
            Set rst = Nothing
        Else
            Err.Clear
            lngCount = 0
        End If
        On Error GoTo ErrHandler
    Else
        On Error Resume Next
        lngCount = Nz(DCount("*", strRecordSource, strWhereCondition), 0)
        If Err.Number <> 0 Then
            Err.Clear
            lngCount = 0
        End If
        On Error GoTo ErrHandler
    End If

    ''----  إذا لم يكن هناك سجلات، تحقق من HasData
    If lngCount = 0 Then
        On Error Resume Next
        DoCmd.OpenReport strReportName, acViewPreview, , strWhereCondition, acHidden, strOpenArgs
        If Err.Number = 0 Then
            ReportHasData = Reports(strReportName).HasData
            DoCmd.Close acReport, strReportName, acSaveNo
        Else
            Err.Clear
            ReportHasData = False
        End If
        On Error GoTo ErrHandler
    Else
        ReportHasData = True
    End If

CleanUp:
    If Not rst Is Nothing Then
        rst.Close
        Set rst = Nothing
    End If
    If Not qdf Is Nothing Then
        Set qdf = Nothing
    End If
    Set dbs = Nothing
    Exit Function

ErrHandler:
    ReportHasData = False
    GoTo CleanUp
End Function

'' ==== إجراء عام: عرض تقرير بعد التحقق من وجوده واحتوائه على بيانات من وجود بيانات وطلب تأكيد الطباعة ====
Public Sub OpenReportSmart(ByVal strReportName As String, _
                                     Optional ByVal bolAskToPrint As Boolean = True, _
                                     Optional ByVal strViewMode As AcView = acViewNormal, _
                                     Optional ByVal strWhereCondition As String = "", _
                                     Optional ByVal strOpenArgs As String = "", _
                                     Optional ByVal bolSilent As Boolean = False)
    Const strTitleConfirm As String = "تأكيد الطباعة"
    Const strTitleAlert As String = "تنبيه"
    Const strTitleError As String = "خطأ"

    Dim strRecordSource As String

    On Error GoTo ErrHandler

    ''---- التحقق من وجود التقرير
    If Not ReportExists(strReportName) Then
        If Not bolSilent Then
            MsgBox "التقرير '" & strReportName & "' غير موجود.", vbExclamation + vbMsgBoxRight + vbMsgBoxRtlReading, strTitleAlert
        End If
        Exit Sub
    End If

    ''----  الحصول على مصدر البيانات
    strRecordSource = GetRecordSource(strReportName)
    If Nz(strRecordSource, "") = "" Then
        If Not bolSilent Then
            MsgBox "التقرير '" & strReportName & "' لا يحتوي على مصدر بيانات.", vbExclamation + vbMsgBoxRight + vbMsgBoxRtlReading, strTitleAlert
        End If
        Exit Sub
    End If

    ''----  التحقق من وجود بيانات
    If Not ReportHasData(strReportName, strRecordSource, strWhereCondition, strOpenArgs) Then
        If Not bolSilent Then
            MsgBox "التقرير '" & strReportName & "' لا يحتوي على بيانات.", vbExclamation + vbMsgBoxRight + vbMsgBoxRtlReading, strTitleAlert
        End If
        Exit Sub
    End If

    ''----  طلب تأكيد الطباعة
    If bolAskToPrint And Not bolSilent Then
        If MsgBox("هل تريد طباعة التقرير '" & strReportName & "'؟", vbYesNo + vbQuestion + vbMsgBoxRight + vbMsgBoxRtlReading, strTitleConfirm) = vbNo Then
            Exit Sub
        End If
    End If

    ''----  فتح التقرير
    DoCmd.OpenReport strReportName, strViewMode, , strWhereCondition, acWindowNormal, strOpenArgs

CleanUp:
    Exit Sub

ErrHandler:
    Select Case Err.Number
        Case 2501
            ''----  تم إلغاء العملية
        Case 2212
            If Not bolSilent Then
                MsgBox "تم إلغاء عملية الطباعة أو تعذر العثور على التقرير '" & strReportName & "'.", _
                       vbExclamation + vbMsgBoxRight + vbMsgBoxRtlReading, strTitleAlert
            End If
        Case Else
            If Not bolSilent Then
                MsgBox "حدث خطأ أثناء فتح التقرير '" & strReportName & "'!" & vbCrLf & _
                       "رقم الخطأ: " & Err.Number & vbCrLf & _
                       "الوصف: " & Err.Description, vbCritical + vbMsgBoxRight + vbMsgBoxRtlReading, strTitleError
            End If
    End Select
    GoTo CleanUp
End Sub

 

وفى هذا الجزء استعرض بعض الامثلة لطرق الاستدعاء واستخدام الكود

' ====== (OpenReportSmart) طرق استدعاء الإجراء الرئيسي  ======

'' 01 --- أبسط استدعاء بدون معلمات إضافية
'' --- يعرض التقرير rptEmployees في الوضع الافتراضي للطباعة، مع تأكيد وظهور الرسائل
Call OpenReportSmart("rptEmployees")


'' 02 --- استدعاء بدون تأكيد
'' --- يعرض التقرير بدون سؤال المستخدم عن التأكيد قبل الطباعة
Call OpenReportSmart("rptEmployees", False)


'' 03 --- فتح التقرير في وضع المعاينة Preview
'' --- يفتح التقرير في وضع المعاينة، مع تأكيد قبل العرض
Call OpenReportSmart("rptEmployees", True, acViewPreview)


'' 04 --- تمرير شرط تصفية Where
'' --- عرض التقرير فقط للموظفين في قسم معين
Call OpenReportSmart("rptEmployees", True, acViewPreview, "DepartmentID = 5")


'' 05 --- تمرير بيانات عبر OpenArgs
'' --- يستخدم OpenArgs داخل التقرير لتخصيص العرض
Call OpenReportSmart("rptEmployees", True, acViewPreview, , "ShowSummary")


'' 06 --- الوضع الصامت (لا يظهر أي رسائل)
'' --- يفترض صحة كل شيء، ولا يعرض أي تنبيهات للمستخدم
Call OpenReportSmart("rptEmployees", , , , , True)


'' 07 --- مثال كامل بجميع المعاملات
'' --- عرض بالتصفية، ووسائط OpenArgs، مع تأكيد، بدون صمت
Call OpenReportSmart("rptEmployees", True, acViewPreview, "IsActive = True", "FromMainMenu", False)

'' 08 --- مثال طباعة تقرير بناءً على اختيار موظف من نموذج
Public Sub Example5_PrintReportWithDynamicFilter()
    ' ' --- التحقق من تحميل نموذج اختيار الموظف
    If CurrentProject.AllForms("frmEmployeeSelector").IsLoaded Then
        Dim strFilter As String
        strFilter = "EmployeeID = " & Forms!frmEmployeeSelector!cboEmployeeID

        Call OpenReportSmart("rptEmployeeAttendance", True, acViewNormal, strFilter)
    Else
        MsgBox "يرجى فتح نموذج اختيار الموظف أولاً.", _
               vbExclamation + vbMsgBoxRight + vbMsgBoxRtlReading, "تنبيه"
    End If
End Sub

'' 09 --- معاينة تقرير ليوم محدد (تاريخ اليوم)
Public Sub Example6_PreviewReportWithDateFilter()
    Dim strFilter As String
    strFilter = "ReportDate = #" & Format(Date, "mm/dd/yyyy") & "#"

    Call OpenReportSmart("rptDailySummary", True, acViewPreview, strFilter)
End Sub

'' 10 --- استدعاء التقرير باستخدام متغير شرط بتنسيقات مختلفة (نصي، رقمي، تاريخي)
''  --- المثال الاساسى
Call OpenReportSmart("rptEmployees", True, acViewPreview, "DepartmentID = 5")

''>>--> رقمي (رقم قسم مثلاً)
Public Sub Example_NumericFilter()
    Dim lngDepartmentID As Long
    lngDepartmentID = 5

    Dim strFilter As String
    strFilter = "DepartmentID = " & lngDepartmentID

    Call OpenReportSmart("rptEmployees", True, acViewPreview, strFilter)
End Sub

''>>--> نصي (اسم الموظف مثلاً)
Public Sub Example_TextFilter()
    Dim strEmployeeName As String
    strEmployeeName = "محمد علي"

    Dim strFilter As String
    strFilter = "EmployeeName = '" & strEmployeeName & "'"

    Call OpenReportSmart("rptEmployees", True, acViewPreview, strFilter)
End Sub

''>>--> تاريخ (بيانات ليوم معين)
Public Sub Example_DateFilter()
    Dim datTargetDate As Date
    datTargetDate = DateSerial(2025, 7, 1)

    Dim strFilter As String
    strFilter = "HireDate = #" & Format(datTargetDate, "mm/dd/yyyy") & "#"

    Call OpenReportSmart("rptEmployees", True, acViewPreview, strFilter)
End Sub

' =======================  استخدام المعايير حسب انواع البيانات  =======================
'>>--> رقمي-----Long / Integer   :  "FieldName = " & Numeric
'>>--> نصي----String             :  "FieldName = '" & النص & "'"
'>>--> تاريخ----Date             :  "FieldName = #" & Format(date, "mm/dd/yyyy") & "#"
' =====================================================================================

ولكن وجب التنويه الى شئ :

الأكواد قيد التجربـــة أنا لسه كاتب الاكواد بناء على سؤال فى المنتدى