jo_2010 قام بنشر الإثنين at 11:25 قام بنشر الإثنين at 11:25 الخبراء الافاضل بعدالتحية اريد كود برمجى لزر فى نموذج كود اذا كان التقرير فارغ لايفتح ويعطى رسالة التقرير فارغ واذا كان بة بيانات يفتح التقرير ويعطى رسالة هل تريد طباعة هذا التقرير ؟ والرسالة بها زر نعم و زر لا خالص الشكر 1
ابو جودي قام بنشر الإثنين at 12:14 قام بنشر الإثنين at 12:14 48 دقائق مضت, jo_2010 said: كود اذا كان التقرير فارغ لايفتح ويعطى رسالة التقرير فارغ واذا كان بة بيانات يفتح التقرير ويعطى رسالة هل تريد طباعة هذا التقرير ؟ والرسالة بها زر نعم و زر لا الموضوع ده قبل الرد لازم نكون عارفين ايه مصدر بيانات التقرير وهل فيه فرز او تصفيه بتتم واللا لاء يعنى ضع مرفقك بالحالة اللى انت عاوزها بالظبط 1
تمت الإجابة ابو جودي قام بنشر الإثنين at 12:49 تمت الإجابة قام بنشر الإثنين at 12:49 على العموم بوجه عام فى كود فتح التقرير من خلا زر امر استخدم 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 1
ابو جودي قام بنشر الإثنين at 14:52 قام بنشر الإثنين at 14:52 ودى فكرة لتحقيق طلبك بشكل مباشر ولكن لا احب اعادة استخدام الاكواد فى نماذج مختلفة او تعديلها كل شوية ان شاء الله تعالى سوف أقوم ببناء وحدة نمطية متخصصة للتحكم فى كل كبيرة وصغيرة لمن يهتم بهذا الموضوع ينتظر ان شاء الله مفاجأه سارة
ابو جودي قام بنشر الإثنين at 17:12 قام بنشر الإثنين at 17:12 وتم بحمد الله الذى تتم بنعمته الصالحات بعد خناقة كبيرة كبيرة كبيـــــــــرة مع بنات أفكارى الكود فى الوحدى النمطية العامة كود ذكى وسحرى ومرن وابن حلال وحيفهمك ويريحك ويلبى كل متطلباتك تقريبا فى التعامل مع التقارير و .... هو انا لسه هاتلكم كتير ما تيجوا نشوف على طول
منتصر الانسي قام بنشر الإثنين at 19:36 قام بنشر الإثنين at 19:36 مع إحترامي لحل الأخ @ابو جودي فالمسألة أبسط من كذا كل ماعليك فعله هو إضافة الكود التالي لحدث عند عدم وجود بياتات أو On No Data الخاص بالتقرير 'رسالة تنبيه MsgBox "لايوجد أي بيانات في التقرير", vbMsgBoxRight + vbMsgBoxRtlReading, "تنبيه" 'إلغاء الأمر وعدم متابعة فتح التقرير Cancel = -1 ليصبح بهذا الشكل Private Sub Report_NoData(Cancel As Integer) 'رسالة تنبيه MsgBox "لايوجد أي بيانات في التقرير", vbMsgBoxRight + vbMsgBoxRtlReading, "تنبيه" 'إلغاء الأمر وعدم متابعة فتح التقرير Cancel = -1 End Sub مع تحياتي 1
ابو جودي قام بنشر الإثنين at 19:45 قام بنشر الإثنين at 19:45 2 دقائق مضت, منتصر الانسي said: كل ماعليك فعله هو إضافة الكود التالي لحدث عند عدم وجود بياتات أو On No Data الخاص بالتقرير يا هلا والله باستاذى القدير و معلمى الجليل الاستاذ @منتصر الانسي هذا الحل ينفع بس فى حالة واحدة فتح التقرير : DoCmd.OpenReport strRptName, acViewPreview ولكن لو اردت الطباعة : DoCmd.OpenReport "Period Report", acViewNormal للاسف لو ما فى بيانات سوف يتم طباعة ورقة بيضاء 1
Foksh قام بنشر الثلاثاء at 03:45 قام بنشر الثلاثاء at 03:45 ولو بعد الرسالة اغلقنا التقرير 😅 برضوا هيطبع صفحة فاضية ! 🙄 1
ابو جودي قام بنشر الثلاثاء at 04:55 قام بنشر الثلاثاء at 04:55 منذ ساعه, Foksh said: ولو بعد الرسالة اغلقنا التقرير 😅 برضوا هيطبع صفحة فاضية ! 🙄 مش توضح الرد ده مع انهو طريقه بالظبط
Foksh قام بنشر الثلاثاء at 07:06 قام بنشر الثلاثاء at 07:06 2 ساعات مضت, ابو جودي said: مش توضح الرد ده مع انهو طريقه بالظبط حقك علي فعلاً ،، انا افتكرت نفسي عملت اقتباس 😂 قصدي مع مشاركة معلمي الفاضل منتصر 1
ابو جودي قام بنشر الثلاثاء at 08:18 قام بنشر الثلاثاء at 08:18 منذ ساعه, Foksh said: حقك علي فعلاً ،، لا انا مش زعلان بس انا علشان مش عندي طابعة فكرت المشكله فى الكود بتاعى 1
منتصر الانسي قام بنشر الثلاثاء at 14:08 قام بنشر الثلاثاء at 14:08 5 ساعات مضت, ابو جودي said: بس انا علشان مش عندي طابعة فكرت المشكله فى الكود بتاعى 18 ساعات مضت, ابو جودي said: هذا الحل ينفع بس فى حالة واحدة فتح التقرير : DoCmd.OpenReport strRptName, acViewPreview ولكن لو اردت الطباعة : DoCmd.OpenReport "Period Report", acViewNormal لا المسألة مش مسألة إن الكود فيه مشكلة انما أنا فكرت في الموضوع من منظورين آخرين الأول طالما وتوجد طريقة أسهل وتنفذ المطلوب لما لا نستفيد منها الثاني الطبيعة البشرية فعلى طول مشاوري في العمل مع الأنظمة لم أجد مستخدم واحد يطبع تقرير بدون مايفتحه في وضع المعاينة وطباعته من هناك وكأنه يريد الإطمئنان على شكل ومحتوى التقرير قبل طباعته 18 ساعات مضت, ابو جودي said: للاسف لو ما فى بيانات سوف يتم طباعة ورقة بيضاء أنا لم يحدث معي هذا الأمر فبمجرد اغلاق رسالة التنبيه تلغى عملية الطباعة عموما الإختلاف في الرأي لايفسد للود قضية في الأخير كلها أفكار تصب في مصلحة أعضاء المنتدى فمن خلالها يمكنهم التعرف على كل البدائل الممكنة للعمل بما يلائمهم منها أو حتى أنهم قد يخرجون منها بأفكار أخرى جديدة مع تحياتي 1
ابو جودي قام بنشر الثلاثاء at 14:22 قام بنشر الثلاثاء at 14:22 16 دقائق مضت, منتصر الانسي said: الأول طالما وتوجد طريقة أسهل وتنفذ المطلوب لما لا نستفيد منها طبعا استاذى الجليل و معلمى القدير اتفق معك تماما تماما فى هذه النقطة 16 دقائق مضت, منتصر الانسي said: الثاني الطبيعة البشرية فعلى طول مشاوري في العمل مع الأنظمة لم أجد مستخدم واحد يطبع تقرير بدون مايفتحه في وضع المعاينة وطباعته من هناك وكأنه يريد الإطمئنان على شكل ومحتوى التقرير قبل طباعته انا فى عملى يا استاذى هناك تقارير اطبعها بشكل مباشر دون محاولة فتحها اساسا نظرا احيانا لضيق الوقت وكثرة العمل و و .... الخ ولكن طبعا انا متأكد من جميع المدخلات والمخرجات وانا على دراية تامة بالكودينج لان من كتابتى وطبعا مسبقا اعرف النتيجة التى سوف احصل عليها من الطباعة 16 دقائق مضت, منتصر الانسي said: أنا لم يحدث معي هذا الأمر فبمجرد اغلاق رسالة التنبيه تلغى عملية الطباعة انا حدث معى هذا الأمر عندما حاولت تجربته فى احد الايام بعد ظهور الرسالة التىفيد بعدم وجود بيانات وفور اغلاق الرسالة تجد الطباعة تعمل جرب حضرتك الان تستخدم الطباعة الى ملف PDF سوف تجده يعمل بعد الرسالة ويقوم بطباعة ( حفظ كملف PDF) للتقرير كهيكل لمحتوى التصميم والعناصر بدون اى بيانات
jjafferr قام بنشر الثلاثاء at 14:32 قام بنشر الثلاثاء at 14:32 17 دقائق مضت, منتصر الانسي said: أنا لم يحدث معي هذا الأمر فبمجرد اغلاق رسالة التنبيه تلغى عملية الطباعة وانا كذلك ، ولكن تبقى ايقونة الطباعة بقرب ساعة الكمبيوتر لثوان ، ثم تختفي. 7 دقائق مضت, ابو جودي said: جرب حضرتك الان تستخدم الطباعة الى ملف PDF يقوم بحذف لملف السابق (إن وُجد) ، ولا يعمل ملف جديد بصفحة فارغة (انا كذلك اعطاني ايحاء ان الصفحة الفارغة تم طباعتها ، ولكني اكمل الخطوات ولم اجد الملف اصلا).
jjafferr قام بنشر الثلاثاء at 14:54 قام بنشر الثلاثاء at 14:54 انا عندي 3 خطوط (دفاعية) لفتح نموذج او تقرير: 1. الاستعلام ، ويكون مصدر البيانات ، ويكون فيه الفرز (للنموذج فقط ، بينما التقرير لا يحترم فرز الاستعلام وانما يجب عمله في التقرير مباشرة) والتصفية ، 2. وقد احتاج الى تصفية اخرى عند فتح النموذج/التقرير ، او اذا عملت على استعلام/نموذج/تقرير ، ولا احبذ تغيير الاستعلام (لأنه هناك نماذج/تقارير اخرى تعتمد عليه) ، هنا اعتمد على الفرز/التصفية عند فتح النموذج/التقرير ، 3. وفي حالات خاصة (جدا خاصة وجدا قليلة) ، اعتمد على وضع شروط عند فتح النموذج/التقرير في كود فتح النموذج/التقرير. فعليه : وفي جميع الحالات اعلاه ، عمل اخوي ابو جودي (لا يعمل في صيغة mde او accde ، لأنه لا يمكن فتح النموذج/التقرير في وضع التصميم) واخوي منتصر يعملان ، وفي بعض الاحيان كنت احتاج الى معرفة اذا هناك سجلات قبل طباعة تقرير (كان يتأخر في الطباعة) ، وكنت معتمد على الاستعلام كمصدر بيانات ، فكنت استعمل الكود التالي (والذي في اعتقادي هو اسرع من فتح التقرير وانتظار حصول الرسالة منه ، ولكن اذا كانت هناك سجلات ، فالتأخير يكون مرتين ، مرة للتأكد من عدد السجلات ، والمرة الاخرى في طباعة السجلات) : if DCount("*","Query Name")=0 then msgbox "لا توجد سجلات للطباعة" else docmd.openreport "Report Name" end if 1
ابو جودي قام بنشر الثلاثاء at 16:22 قام بنشر الثلاثاء at 16:22 منذ ساعه, jjafferr said: وفي جميع الحالات اعلاه ، عمل اخوي ابو جودي (لا يعمل في صيغة mde او accde ، لأنه لا يمكن فتح النموذج/التقرير في وضع التصميم) اه حضرتك تقصد كود الوحدة النمطية العامة
منتصر الانسي قام بنشر الثلاثاء at 17:55 قام بنشر الثلاثاء at 17:55 ماشاء الله أعتقد أن المداخلات من @ابو جودي و @jjafferr قد أثرت الموضوع وغطت الطرق الأكثر عملية مع توضيح مزايا وعيوب كل طريقة ولكن وتوضيحا لكلام الاخ @ابو جودي 3 ساعات مضت, ابو جودي said: جرب حضرتك الان تستخدم الطباعة الى ملف PDF سوف تجده يعمل بعد الرسالة ويقوم بطباعة ( حفظ كملف PDF) للتقرير كهيكل لمحتوى التصميم والعناصر بدون اى بيانات انا استخدم طابعة إفتراضية تقوم بإستخراج التقرير كملف PDF وتعمل مثل الطابعة الحقيقة أما كلامك فمعناه أنك تستخدم الأمر DoCmd.OutputTo وهذا لايعتبر أمر طباعة وإنما امر لإستخراج الكائن بصيغة محددة بحالته كيفما تكون ولو لاحظت فإن الرسالة لاتظهر من الأساس فحدث عند عدم وجود بياتات أو On No Data الخاص بالتقرير يتطلب استخدام الأمر DoCmd.OpenReport حتى يتم تفعيله ولكن مثلما أسلفت فهذه المناقشات جميلة لنتعرف كلنا على الطرق المختلفة لحل المشاكل فقد يحتاجها أحدنا يوما ما مع تحياتي
jo_2010 قام بنشر الأربعاء at 11:01 الكاتب قام بنشر الأربعاء at 11:01 في 21/7/2025 at 17:52, ابو جودي said: ودى فكرة لتحقيق طلبك بشكل مباشر ولكن لا احب اعادة استخدام الاكواد فى نماذج مختلفة او تعديلها كل شوية ان شاء الله تعالى سوف أقوم ببناء وحدة نمطية متخصصة للتحكم فى كل كبيرة وصغيرة لمن يهتم بهذا الموضوع ينتظر ان شاء الله مفاجأه سارة ربنا يوفقك ويكرمك
jjafferr قام بنشر الأربعاء at 18:10 قام بنشر الأربعاء at 18:10 في 22/7/2025 at 20:22, ابو جودي said: في 22/7/2025 at 18:54, jjafferr said: وفي جميع الحالات اعلاه ، عمل اخوي ابو جودي (لا يعمل في صيغة mde او accde ، لأنه لا يمكن فتح النموذج/التقرير في وضع التصميم) اه حضرتك تقصد كود الوحدة النمطية العامة نعم، لا يمكنك عمل: اقتباس DoCmd.OpenReport strReportName, acDesign, , , acHidden
ابو جودي قام بنشر منذ 9 ساعات قام بنشر منذ 9 ساعات في 22/7/2025 at 17:54, jjafferr said: في جميع الحالات اعلاه ، عمل اخوي ابو جودي (لا يعمل في صيغة mde او accde ، لأنه لا يمكن فتح النموذج/التقرير في وضع التصميم) طيب ممكن رايك استاذى الجليل ومعلمى القدير استاذ @jjafferr فى التعديلات التالية والتى تمت على الوحدة انمطية العامة لتحاشى المشكلات السابقة وكذلك قمت بدعم : 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.