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

كود لفتح تقرير بشرط


إذهب إلى الإجابة الإجابة بواسطة ابو جودي,

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

قام بنشر

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

بعدالتحية

اريد كود برمجى لزر فى نموذج

كود اذا كان التقرير فارغ لايفتح ويعطى رسالة التقرير فارغ  واذا كان بة بيانات يفتح التقرير ويعطى رسالة هل تريد طباعة هذا التقرير ؟ والرسالة بها زر نعم و زر لا

خالص الشكر

  • Like 1
قام بنشر
48 دقائق مضت, jo_2010 said:

كود اذا كان التقرير فارغ لايفتح ويعطى رسالة التقرير فارغ  واذا كان بة بيانات يفتح التقرير ويعطى رسالة هل تريد طباعة هذا التقرير ؟ والرسالة بها زر نعم و زر لا

 

الموضوع ده قبل الرد لازم نكون عارفين ايه مصدر بيانات التقرير
وهل فيه فرز او تصفيه بتتم واللا لاء

يعنى ضع مرفقك بالحالة اللى انت عاوزها بالظبط

  • Like 1
  • تمت الإجابة
قام بنشر

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

Dim strRptName As String
Dim strMsgNoData As String
Dim strMsgConfirm As String

'' --- اسم التقرير
strRptName = ""

'' --- الرسالة إذا لم توجد بيانات
strMsgNoData = "التقرير فارغ."

'' --- رسالة التأكيد
strMsgConfirm = "هل تريد طباعة هذا التقرير؟"


    '' === فتح التقرير بشكل غير ظاهر للمستخدم (يتم عرضه في الخلفية للتحقق) ===
    DoCmd.OpenReport strRptName, acViewPreview, , , acHidden

    '' === التحقق من وجود بيانات ===
    If Reports(strRptName).HasData Then
        '' --- توجد بيانات، نسأل المستخدم
        If MsgBox(strMsgConfirm, vbYesNo + vbQuestion + vbMsgBoxRtlReading + vbMsgBoxRight, "تأكيد الطباعة") = vbNo Then
            DoCmd.Close acReport, strRptName, acSaveNo
        Else
            '' --- إظهار التقرير لأنه كان مخفي
            DoCmd.SelectObject acReport, strRptName, True
        End If
    Else
        '' --- لا توجد بيانات، نغلق التقرير ونعرض رسالة
        DoCmd.Close acReport, strRptName, acSaveNo
        MsgBox strMsgNoData, vbExclamation + vbMsgBoxRtlReading + vbMsgBoxRight, "تنبيه"
    End If

    Exit Sub


 

  • Like 1
قام بنشر

ودى فكرة لتحقيق طلبك بشكل مباشر 

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

او تعديلها كل شوية

ان شاء الله تعالى سوف أقوم ببناء وحدة نمطية متخصصة للتحكم فى كل كبيرة وصغيرة :yes:

لمن يهتم بهذا الموضوع ينتظر ان شاء الله مفاجأه سارة :fff:

 

قام بنشر

وتم بحمد الله الذى تتم بنعمته الصالحات بعد خناقة كبيرة كبيرة كبيـــــــــرة مع بنات أفكارى :biggrin:

الكود فى الوحدى النمطية العامة 

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

و .... هو انا لسه هاتلكم كتير 

ما تيجوا نشوف على طول :wink2:

 

 

 

قام بنشر

مع إحترامي لحل الأخ @ابو جودي فالمسألة أبسط من كذا

كل ماعليك فعله هو إضافة الكود التالي لحدث عند عدم وجود بياتات أو On No Data الخاص بالتقرير

'رسالة تنبيه
MsgBox "لايوجد أي بيانات في التقرير", vbMsgBoxRight + vbMsgBoxRtlReading, "تنبيه"

'إلغاء الأمر وعدم متابعة فتح التقرير
Cancel = -1

ليصبح بهذا الشكل

Private Sub Report_NoData(Cancel As Integer)

    'رسالة تنبيه
    MsgBox "لايوجد أي بيانات في التقرير", vbMsgBoxRight + vbMsgBoxRtlReading, "تنبيه"
    
    'إلغاء الأمر وعدم متابعة فتح التقرير
    Cancel = -1
    
End Sub

مع تحياتي

  • Like 1
قام بنشر
2 دقائق مضت, منتصر الانسي said:

كل ماعليك فعله هو إضافة الكود التالي لحدث عند عدم وجود بياتات أو On No Data الخاص بالتقرير

يا هلا والله باستاذى القدير و معلمى الجليل الاستاذ @منتصر الانسي

هذا الحل ينفع بس فى حالة واحدة
فتح التقرير : DoCmd.OpenReport strRptName, acViewPreview

ولكن لو اردت الطباعة : DoCmd.OpenReport "Period Report", acViewNormal

للاسف لو ما فى بيانات سوف يتم طباعة ورقة بيضاء :yes:

  • Confused 1
قام بنشر

ولو بعد الرسالة اغلقنا التقرير 😅

برضوا هيطبع صفحة فاضية ! 🙄

  • Confused 1
قام بنشر
منذ ساعه, Foksh said:

ولو بعد الرسالة اغلقنا التقرير 😅

برضوا هيطبع صفحة فاضية ! 🙄

مش توضح الرد ده مع انهو طريقه بالظبط

قام بنشر
2 ساعات مضت, ابو جودي said:

مش توضح الرد ده مع انهو طريقه بالظبط

حقك علي فعلاً ،،

انا افتكرت نفسي عملت اقتباس 😂

قصدي مع مشاركة معلمي الفاضل منتصر 

  • Haha 1
قام بنشر
5 ساعات مضت, ابو جودي said:

بس انا علشان مش عندي طابعة فكرت المشكله فى الكود بتاعى

18 ساعات مضت, ابو جودي said:

هذا الحل ينفع بس فى حالة واحدة
فتح التقرير : DoCmd.OpenReport strRptName, acViewPreview

ولكن لو اردت الطباعة : DoCmd.OpenReport "Period Report", acViewNormal

لا المسألة مش مسألة إن الكود فيه مشكلة انما أنا فكرت في الموضوع من منظورين آخرين

الأول طالما وتوجد طريقة أسهل وتنفذ المطلوب لما لا نستفيد منها

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

18 ساعات مضت, ابو جودي said:

للاسف لو ما فى بيانات سوف يتم طباعة ورقة بيضاء :yes:

أنا لم يحدث معي هذا الأمر فبمجرد اغلاق رسالة التنبيه تلغى عملية الطباعة

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

مع تحياتي

  • Like 1
قام بنشر
16 دقائق مضت, منتصر الانسي said:

الأول طالما وتوجد طريقة أسهل وتنفذ المطلوب لما لا نستفيد منها

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

16 دقائق مضت, منتصر الانسي said:

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

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

نظرا احيانا لضيق الوقت وكثرة العمل و و .... الخ 


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

16 دقائق مضت, منتصر الانسي said:

أنا لم يحدث معي هذا الأمر فبمجرد اغلاق رسالة التنبيه تلغى عملية الطباعة

انا حدث معى هذا الأمر عندما حاولت تجربته فى احد الايام بعد ظهور الرسالة التىفيد بعدم وجود بيانات وفور اغلاق الرسالة تجد الطباعة تعمل 

 

جرب حضرتك الان تستخدم الطباعة الى ملف PDF

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

 

قام بنشر
17 دقائق مضت, منتصر الانسي said:

أنا لم يحدث معي هذا الأمر فبمجرد اغلاق رسالة التنبيه تلغى عملية الطباعة

وانا كذلك ،

ولكن تبقى ايقونة الطباعة بقرب ساعة الكمبيوتر لثوان ، ثم تختفي.

 

7 دقائق مضت, ابو جودي said:

جرب حضرتك الان تستخدم الطباعة الى ملف PDF

يقوم بحذف لملف السابق (إن وُجد) ، ولا يعمل ملف جديد بصفحة فارغة (انا كذلك اعطاني ايحاء ان الصفحة الفارغة تم طباعتها ، ولكني اكمل الخطوات ولم اجد الملف اصلا).

قام بنشر

 

 

انا عندي 3 خطوط (دفاعية) لفتح نموذج او تقرير:

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

2. وقد احتاج الى تصفية اخرى عند فتح النموذج/التقرير ، او اذا عملت على استعلام/نموذج/تقرير ، ولا احبذ تغيير الاستعلام (لأنه هناك نماذج/تقارير اخرى تعتمد عليه) ،

هنا اعتمد على الفرز/التصفية عند فتح النموذج/التقرير ،

3. وفي حالات خاصة (جدا خاصة وجدا قليلة) ، اعتمد على وضع شروط عند فتح النموذج/التقرير في كود فتح النموذج/التقرير.

 

فعليه :

وفي جميع الحالات اعلاه ، عمل اخوي ابو جودي (لا يعمل في صيغة mde او accde ، لأنه لا يمكن فتح النموذج/التقرير في وضع التصميم) واخوي منتصر يعملان ،

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

if DCount("*","Query Name")=0 then
	msgbox "لا توجد سجلات للطباعة"
else
	docmd.openreport "Report Name"
end if

 

  • Like 1
قام بنشر
منذ ساعه, jjafferr said:

وفي جميع الحالات اعلاه ، عمل اخوي ابو جودي (لا يعمل في صيغة mde او accde ، لأنه لا يمكن فتح النموذج/التقرير في وضع التصميم)

اه حضرتك تقصد كود الوحدة النمطية العامة 

قام بنشر

ماشاء الله أعتقد أن المداخلات من @ابو جودي و @jjafferr قد أثرت الموضوع وغطت الطرق الأكثر عملية مع توضيح مزايا وعيوب كل طريقة

ولكن وتوضيحا لكلام الاخ @ابو جودي

3 ساعات مضت, ابو جودي said:

جرب حضرتك الان تستخدم الطباعة الى ملف PDF

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

انا استخدم طابعة إفتراضية تقوم بإستخراج التقرير كملف PDF وتعمل مثل الطابعة الحقيقة

أما كلامك فمعناه أنك تستخدم الأمر DoCmd.OutputTo وهذا لايعتبر أمر طباعة وإنما امر لإستخراج الكائن بصيغة محددة بحالته كيفما تكون ولو لاحظت فإن الرسالة لاتظهر من الأساس فحدث عند عدم وجود بياتات أو On No Data الخاص بالتقرير يتطلب استخدام الأمر DoCmd.OpenReport حتى يتم تفعيله

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

مع تحياتي

قام بنشر
في 21‏/7‏/2025 at 17:52, ابو جودي said:

ودى فكرة لتحقيق طلبك بشكل مباشر 

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

او تعديلها كل شوية

ان شاء الله تعالى سوف أقوم ببناء وحدة نمطية متخصصة للتحكم فى كل كبيرة وصغيرة :yes:

لمن يهتم بهذا الموضوع ينتظر ان شاء الله مفاجأه سارة :fff:

 

ربنا يوفقك ويكرمك

قام بنشر
في 22‏/7‏/2025 at 20:22, ابو جودي said:
في 22‏/7‏/2025 at 18:54, jjafferr said:

وفي جميع الحالات اعلاه ، عمل اخوي ابو جودي (لا يعمل في صيغة mde او accde ، لأنه لا يمكن فتح النموذج/التقرير في وضع التصميم)

اه حضرتك تقصد كود الوحدة النمطية العامة

 

نعم، لا يمكنك عمل:

اقتباس
DoCmd.OpenReport strReportName, acDesign, , , acHidden

 

قام بنشر
في 22‏/7‏/2025 at 17:54, jjafferr said:

في جميع الحالات اعلاه ، عمل اخوي ابو جودي (لا يعمل في صيغة mde او accde ، لأنه لا يمكن فتح النموذج/التقرير في وضع التصميم)

طيب ممكن رايك استاذى الجليل ومعلمى القدير استاذ @jjafferr :fff:

فى التعديلات التالية والتى تمت على الوحدة انمطية العامة لتحاشى المشكلات السابقة وكذلك قمت بدعم : DCount بناء على توجيهاتكم

في 22‏/7‏/2025 at 17:54, jjafferr said:
if DCount("*"

 

كود الوحدة النمطية الجديد

Option Compare Database
Option Explicit

Private m_dictHasDataCache As Object
Private mbolDebugMode As Boolean

' === تمكين أو تعطيل وضع التتبع (نافذة Immediate)
Public Sub EnableDebugMode(Optional ByVal bolEnable As Boolean = True)
    mbolDebugMode = bolEnable
End Sub

' === التحقق من وجود تقرير
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

' === الحصول على RecordSource
Private Function GetRecordSource(ByVal strReportName As String) As String
    On Error GoTo ErrHandler
    DoCmd.OpenReport strReportName, acViewPreview, , , acHidden
    GetRecordSource = Trim(Reports(strReportName).RecordSource)
    DoCmd.Close acReport, strReportName
    Exit Function
ErrHandler:
    GetRecordSource = ""
End Function

' === تنظيف الكاشات
Public Sub ClearCaches()
    If Not m_dictHasDataCache Is Nothing Then
        m_dictHasDataCache.RemoveAll
    End If
End Sub

' === تحديد نوع بيانات حقل في جدول أو استعلام
Private Function GetFieldDataType(ByVal strRecordSource As String, ByVal strFieldName As String) As Integer
    Dim dbs As DAO.Database
    Dim tdf As DAO.TableDef
    Dim qdf As DAO.QueryDef
    Dim fld As DAO.Field

    On Error GoTo ErrHandler
    Set dbs = CurrentDb
    On Error Resume Next
    Set tdf = dbs.TableDefs(strRecordSource)
    If Err.Number = 0 Then
        Set fld = tdf.Fields(strFieldName)
        GetFieldDataType = fld.Type
    Else
        Err.Clear
        Set qdf = dbs.QueryDefs(strRecordSource)
        If Err.Number = 0 Then
            Set fld = qdf.Fields(strFieldName)
            GetFieldDataType = fld.Type
        Else
            GetFieldDataType = dbText
        End If
    End If
    On Error GoTo ErrHandler
    Exit Function
ErrHandler:
    GetFieldDataType = dbText
End Function

' === تنسيق المعلمات تلقائيًا بناءً على النوع
Public Function FormatParameterValue(varValue As Variant, Optional ByVal dataType As Integer = 0) As String
    If IsNull(varValue) Or IsEmpty(varValue) Then
        FormatParameterValue = "NULL"
        Exit Function
    End If
    If dataType = 0 Then
        Select Case VarType(varValue)
            Case vbString
                FormatParameterValue = "'" & Replace(varValue, "'", "''") & "'"
            Case vbDate
                FormatParameterValue = "#" & Format(varValue, "mm\/dd\/yyyy") & "#"
            Case vbBoolean
                FormatParameterValue = IIf(varValue, "True", "False")
            Case vbNull, vbEmpty
                FormatParameterValue = "NULL"
            Case Else
                FormatParameterValue = CStr(varValue)
        End Select
    Else
        Select Case dataType
            Case dbText, dbMemo
                FormatParameterValue = "'" & Replace(varValue, "'", "''") & "'"
            Case dbLong, dbInteger, dbByte, dbDouble, dbSingle
                FormatParameterValue = CStr(varValue)
            Case dbDate
                FormatParameterValue = "#" & Format(varValue, "mm\/dd\/yyyy") & "#"
            Case dbBoolean
                FormatParameterValue = IIf(varValue, "True", "False")
            Case Else
                FormatParameterValue = "NULL"
        End Select
    End If
End Function

' === تعقيم النصوص لتضمينها داخل استعلامات SQL
Public Function SafeSql(strValue As String) As String
    If IsNull(strValue) Or Trim(strValue) = "" Then
        SafeSql = "NULL"
    Else
        SafeSql = "'" & Replace(strValue, "'", "''") & "'"
    End If
End Function

' === توليد شرط تصفية ذكي بناءً على اسم الحقل والقيمة
Public Function BuildFilter( _
    ByVal strFieldName As String, _
    ByVal varFieldValue As Variant, _
    Optional ByVal strRecordSource As String = "") As String
    If IsNull(varFieldValue) Or IsEmpty(varFieldValue) Or Trim(CStr(varFieldValue)) = "" Then
        BuildFilter = vbNullString
        Exit Function
    End If
    Dim dataType As Integer
    If strRecordSource <> "" Then
        dataType = GetFieldDataType(strRecordSource, strFieldName)
    Else
        dataType = 0 ' Use VarType
    End If
    BuildFilter = strFieldName & " = " & FormatParameterValue(varFieldValue, dataType)
End Function

' === استخراج قيمة من strFilter
Private Function ExtractFilterValue(ByVal strFilter As String) As String
    If InStr(strFilter, "=") > 0 Then
        Dim strValue As String
        strValue = Trim(Mid(strFilter, InStr(strFilter, "=") + 1))
        strValue = Replace(strValue, "'", "")
        strValue = Replace(strValue, "#", "")
        ExtractFilterValue = strValue
    Else
        ExtractFilterValue = ""
    End If
End Function

' === التحقق مما إذا كان التقرير يحتوي على بيانات
Private Function ReportHasData( _
    ByVal strReportName As String, _
    Optional ByVal strFilter As String = "", _
    Optional ByVal strOpenArgs As String = "", _
    Optional ByVal dictParameters As Object = Nothing, _
    Optional ByVal bolUseCache As Boolean = True) As Boolean

    On Error GoTo ExitWithError
    Dim strDebugMsg As String
    Dim rpt As Report
    Dim dbs As DAO.Database
    Dim qdf As DAO.QueryDef
    Dim rst As DAO.Recordset
    Dim prm As DAO.Parameter
    Dim strRecordSource As String
    Dim strCacheKey As String
    Dim strFilterValue As String

    strDebugMsg = "Report: " & strReportName & vbCrLf & "Filter: " & strFilter & vbCrLf

    ' --- إنشاء قاموس التخزين المؤقت
    If m_dictHasDataCache Is Nothing Then
        Set m_dictHasDataCache = CreateObject("Scripting.Dictionary")
    End If
    strCacheKey = strReportName & "|" & strFilter
    If bolUseCache And m_dictHasDataCache.Exists(strCacheKey) Then
        ReportHasData = m_dictHasDataCache(strCacheKey)
        strDebugMsg = strDebugMsg & "Retrieved from Cache: " & ReportHasData & vbCrLf
        If mbolDebugMode Then Debug.Print strDebugMsg
        Exit Function
    End If

    ' --- الحصول على RecordSource
    strRecordSource = GetRecordSource(strReportName)
    If strRecordSource = "" Then
        strDebugMsg = strDebugMsg & "No RecordSource found" & vbCrLf
        GoTo OpenAndCheckWithHasData
    End If
    strDebugMsg = strDebugMsg & "RecordSource: " & strRecordSource & vbCrLf

    ' --- محاولة استخدام DCount
    On Error Resume Next
    If strFilter <> "" Then
        If DCount("*", strRecordSource, strFilter) > 0 Then
            ReportHasData = True
            m_dictHasDataCache(strCacheKey) = ReportHasData
            strDebugMsg = strDebugMsg & "DCount HasData: " & ReportHasData & vbCrLf
            If mbolDebugMode Then Debug.Print strDebugMsg
            Exit Function
        End If
    Else
        If DCount("*", strRecordSource) > 0 Then
            ReportHasData = True
            m_dictHasDataCache(strCacheKey) = ReportHasData
            strDebugMsg = strDebugMsg & "DCount HasData: " & ReportHasData & vbCrLf
            If mbolDebugMode Then Debug.Print strDebugMsg
            Exit Function
        End If
    End If
    Err.Clear
    On Error GoTo ExitWithError

    ' --- استخراج قيمة من strFilter إذا كانت موجودة
    strFilterValue = ExtractFilterValue(strFilter)
    strDebugMsg = strDebugMsg & "Extracted Filter Value: " & strFilterValue & vbCrLf

    ' --- محاولة التحقق باستخدام RecordSource
    Set dbs = CurrentDb
    On Error Resume Next
    Set qdf = dbs.QueryDefs(strRecordSource)
    If Err.Number = 0 And qdf.Parameters.Count > 0 Then
        strDebugMsg = strDebugMsg & "Parameters Count: " & qdf.Parameters.Count & vbCrLf
        For Each prm In qdf.Parameters
            strDebugMsg = strDebugMsg & "Parameter: " & prm.Name & vbCrLf
            If Not dictParameters Is Nothing And dictParameters.Exists(prm.Name) Then
                prm.Value = FormatParameterValue(dictParameters(prm.Name), prm.Type)
                strDebugMsg = strDebugMsg & "Assigned from dictParameters: " & prm.Value & vbCrLf
            ElseIf InStr(prm.Name, "Forms!") > 0 Then
                Dim strFormName As String
                strFormName = Split(prm.Name, "!")(1)
                If CurrentProject.AllForms(strFormName).IsLoaded Then
                    prm.Value = Eval(prm.Name)
                    strDebugMsg = strDebugMsg & "Assigned from Eval(" & prm.Name & "): " & prm.Value & vbCrLf
                Else
                    strDebugMsg = strDebugMsg & "Form not loaded: " & strFormName & vbCrLf
                    GoTo OpenAndCheckWithHasData
                End If
            ElseIf strFilterValue <> "" Then
                prm.Value = FormatParameterValue(strFilterValue, prm.Type)
                strDebugMsg = strDebugMsg & "Assigned from strFilterValue: " & prm.Value & vbCrLf
            Else
                strDebugMsg = strDebugMsg & "No value for parameter: " & prm.Name & vbCrLf
                GoTo OpenAndCheckWithHasData
            End If
        Next prm
        Set rst = qdf.OpenRecordset(dbOpenSnapshot, dbReadOnly)
        If Err.Number = 0 Then
            ReportHasData = Not rst.EOF
            strDebugMsg = strDebugMsg & "Recordset HasData: " & ReportHasData & vbCrLf
            rst.Close
            m_dictHasDataCache(strCacheKey) = ReportHasData
            If mbolDebugMode Then Debug.Print strDebugMsg
            Exit Function
        End If
        Err.Clear
    End If
    On Error GoTo ExitWithError

OpenAndCheckWithHasData:
    ' --- فتح التقرير مؤقتًا في الخلفية (كملاذ أخير)
    DoCmd.OpenReport strReportName, acViewPreview, , strFilter, acHidden, strOpenArgs
    Set rpt = Reports(strReportName)
    ReportHasData = (rpt.HasData <> 0)
    strDebugMsg = strDebugMsg & "Report HasData: " & ReportHasData & vbCrLf
    DoCmd.Close acReport, strReportName

    m_dictHasDataCache(strCacheKey) = ReportHasData
    If mbolDebugMode Then Debug.Print strDebugMsg
    Exit Function

ExitWithError:
    strDebugMsg = strDebugMsg & "Error: " & Err.Number & " - " & Err.Description & vbCrLf
    ReportHasData = True ' افتراض وجود بيانات إذا فشل التحقق
    If mbolDebugMode Then Debug.Print strDebugMsg
End Function

' === دالة رئيسية لفتح التقارير الذكية
Public Function OpenReportSmart( _
    ByVal strReportName As String, _
    Optional ByVal bolConfirm As Boolean = True, _
    Optional ByVal enmView As AcView = acViewNormal, _
    Optional ByVal strWhereCondition As String = vbNullString, _
    Optional ByVal varOpenArgs As Variant, _
    Optional ByVal bolSilentMode As Boolean = False, _
    Optional ByVal dictParameters As Object = Nothing, _
    Optional ByVal bolUseCache As Boolean = True, _
    Optional ByVal bolSkipDataCheck As Boolean = False) As Boolean

    Const strTitleConfirm As String = "تأكيد"
    Const strTitleAlert As String = "تنبيه"
    Const strTitleError As String = "خطأ"
    Dim strFilter As String
    Dim strArgs As String
    Dim strRecordSource As String

    On Error GoTo ExitWithError
    ' --- التحقق من وجود التقرير
    If Not ReportExists(strReportName) Then
        If Not bolSilentMode Then
            MsgBox "التقرير '" & strReportName & "' غير موجود.", vbExclamation + vbMsgBoxRight + vbMsgBoxRtlReading, strTitleAlert
        End If
        OpenReportSmart = False
        Exit Function
    End If

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

    ' --- تنسيق الفلتر والمعلمات
    strFilter = Nz(strWhereCondition, vbNullString)
    If Not IsMissing(varOpenArgs) Then strArgs = CStr(varOpenArgs)

    ' --- التأكيد قبل الفتح
    If bolConfirm And Not bolSilentMode Then
        If MsgBox("هل تريد عرض التقرير: " & vbCrLf & strReportName & "؟", vbQuestion + vbYesNo + vbMsgBoxRight + vbMsgBoxRtlReading, strTitleConfirm) = vbNo Then
            OpenReportSmart = False
            Exit Function
        End If
    End If

    ' --- التحقق من وجود بيانات (إذا لم يُطلب تخطي التحقق)
    If Not bolSkipDataCheck Then
        If Not ReportHasData(strReportName, strFilter, strArgs, dictParameters, bolUseCache) Then
            If Not bolSilentMode Then
                MsgBox "التقرير لا يحتوي على بيانات.", vbInformation + vbMsgBoxRight + vbMsgBoxRtlReading, strTitleAlert
            End If
            OpenReportSmart = False
            Exit Function
        End If
    End If

    ' --- فتح التقرير
    DoCmd.OpenReport strReportName, enmView, , strFilter, , strArgs
    If mbolDebugMode Then
        Debug.Print "تم فتح التقرير: " & strReportName
        If strFilter <> "" Then Debug.Print ">> الفلتر: " & strFilter
        If strArgs <> "" Then Debug.Print ">> OpenArgs: " & strArgs
    End If

    OpenReportSmart = True
    Exit Function

ExitWithError:
    Select Case Err.Number
        Case 2501, 2212
            If Not bolSilentMode Then
                MsgBox "تم إلغاء عملية الطباعة أو تعذر العثور على التقرير.", vbExclamation + vbMsgBoxRight + vbMsgBoxRtlReading, strTitleAlert
            End If
        Case Else
            If Not bolSilentMode Then
                MsgBox "حدث خطأ أثناء فتح التقرير: " & Err.Number & " | " & Err.Description, vbExclamation + vbMsgBoxRight + vbMsgBoxRtlReading, strTitleError
            End If
    End Select
    OpenReportSmart = False
End Function

 

ودى دالة توثيقية لامثلة الاستدعاء المختلفة

' === دالة توثيقية: أمثلة استخدام OpenReportSmart
Private Sub OpenReportSmart_Examples()
    #If False Then
        Dim strFilter As String
        Dim strRecordSource As String
        
        ' [01] استدعاء بسيط لفتح تقرير بدون فلتر أو تأكيد
        Call OpenReportSmart("rptEmployees", False)
        
        ' [02] فتح تقرير في وضع المعاينة مع تأكيد
        Call OpenReportSmart("rptEmployees", True, acViewPreview)
        
        ' [03] تصفية بسيطة باستخدام شرط ثابت
        Call OpenReportSmart("rptEmployees", True, acViewPreview, "DepartmentID = 5")
        
        ' [04] فتح تقرير مع OpenArgs لتمرير معلومات إضافية
        Call OpenReportSmart("rptEmployees", True, acViewPreview, , "ShowSummary")
        
        ' [05] فتح تقرير في الوضع الصامت (بدون رسائل خطأ)
        Call OpenReportSmart("rptEmployees", , , , , True)
        
        ' [06] استدعاء كامل مع فلتر، OpenArgs، وتأكيد
        Call OpenReportSmart("rptEmployees", True, acViewPreview, "IsActive = True", "FromMainMenu", False)
        
        ' [07] تصفية ديناميكية من نموذج باستخدام BuildFilter
        If CurrentProject.AllForms("frmEmployeeSelector").IsLoaded Then
            strRecordSource = GetRecordSource("rptEmployeeAttendance")
            strFilter = BuildFilter("EmployeeID", Forms!frmEmployeeSelector!cboEmployeeID, strRecordSource)
            Call OpenReportSmart("rptEmployeeAttendance", True, acViewNormal, strFilter)
        End If
        
        ' [08] تصفية بتاريخ باستخدام BuildFilter
        strRecordSource = GetRecordSource("rptDailySummary")
        strFilter = BuildFilter("ReportDate", Date, strRecordSource)
        Call OpenReportSmart("rptDailySummary", True, acViewPreview, strFilter)
        
        ' [09] تصفية بنص باستخدام BuildFilter
        Dim strEmployeeName As String
        strEmployeeName = "محمد علي"
        strRecordSource = GetRecordSource("rptEmployees")
        strFilter = BuildFilter("EmployeeName", strEmployeeName, strRecordSource)
        Call OpenReportSmart("rptEmployees", True, acViewPreview, strFilter)
        
        ' [10] فتح تقرير مع تخطي التحقق من البيانات (لتقليل التأخير)
        Call OpenReportSmart("rptEmployees", True, acViewPreview, , , , , , True)
        
        ' [11] مثال مشابه لـ rpt01StudentsLists مع فلتر Period
        If CurrentProject.AllForms("frmStudentsFilter").IsLoaded Then
            strRecordSource = GetRecordSource("rpt01StudentsLists")
            strFilter = BuildFilter("Period", Forms!frmStudentsFilter!cboPeriod, strRecordSource)
            Call OpenReportSmart("rpt01StudentsLists", True, acViewPreview, strFilter, Forms!frmStudentsFilter!cboPeriod)
        End If
        
        ' [12] فتح تقرير مع فلتر معقد وتخطي التحقق من البيانات
        strFilter = "DepartmentID = 5 AND IsActive = True"
        Call OpenReportSmart("rptEmployees", True, acViewPreview, strFilter, , , , , True)
        
        ' [13] فتح تقرير مع تعطيل التخزين المؤقت
        strRecordSource = GetRecordSource("rptEmployees")
        strFilter = BuildFilter("DepartmentID", 10, strRecordSource)
        Call OpenReportSmart("rptEmployees", True, acViewPreview, strFilter, , , , False)
    #End If
End Sub

 

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