البحث في الموقع

السلام عليكم ورحمة الله وبركاته سوف أقدم وحدة نمطية عامة متقدمة تتيح لك فتح أي تقرير في الاكسس بطريقة ديناميكية مع التحقق من وجود التقرير ومصدر بياناته واحتوائه على بيانات قبل العرض أو الطباعة الخصائص والمميزات تحقق تلقائي من وجود التقرير قبل عرضه دعم التصفية من خلال تمرير شروط 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") & "#" ' ===================================================================================== ولكن وجب التنويه الى شئ : الأكواد قيد التجربـــة أنا لسه كاتب الاكواد بناء على سؤال فى المنتدى

• طباعة التقرير مباشرة من نموذج فى الاكسيس • طباعة التقرير من داخل التقرير نفسه • معالجة الاخطاء عند الغاء امر الطباعة RUN TIME ERROR https://youtu.be/nm_gxqt7D-U

السلام عليكم جميعا عندما اريد تصدير التقرير الي اكسل تاتي هذه الرساله 39 عدد صفحات التقرير صفحه

تحية طيبة لجميع اساتذة واعضاء المنتدى الكرام.. لدي نموذج مبسط لجدولين احدهما لمعلومات الموظفين والآخر لمهارات كلاً منهم , المطلوب عمل تقرير يظهر جميع الموظفين مع جميع المهارات ان امتلكوها . حاولت ان اعمل استعلامين الاستعلام الاول :اظهر لدي فقط الموظفين الذين لديهم مهارات دون ان يظهر البقية وذلك لارتباط الجدولين بـ (ID) الذي يمثل رقم الموظف كما موضح في الصورة رقم 3 اما الاستعلام الثاني : فهو استعلام تحديث بيانات المهارات الى جدول المعلومات لأقوم بعمل تقرير اخذ فيه البيانات فقط من جدول المعلومات وهذه الطريقة استطعت ان اظهر جميع الموظفين لكن لم تأتي بالنتيجة المطلوبه فقط جاء التحديث فقط بأخر البيانات المدخلة لمهارات الموظفين ولم يأتي بها جميعا , كما موضح في الصورة رقم 4 النتيجة المطلوبة للتقرير هي كما في موضح في الصورة رقم 5 النموذج المبسط مرفق ادناه. جزيل الشكر لكل من يتابع الموضوع.. Update22-3.rar

السلام عليكم ورحمة الله وبركاتة هل يوجد كود لحفظ التقرير الى صيغة pdf وشكرا

السلام عليكم كان المفروض ان يكون هذا الموضوع كجواب للموضوع والمشكلة هي ان ارقام التسلسل بالعربي ، في كل من التقارير الفرعية ليست بالتسلسل المطلوب ، ولا السنه بالتسلسل الصحيح . نعرف اذا اردنا ان نعمل اكثر من عمود في التقرير ، فاننا نستعمل اعدادات الصفحة في التقرير . اذا التقرير بالانجليزي ، فكل شيء تمام وبالترتيب/التسلسل المطلوب ، ولكن للأسف لما نريد الاعمدة بالتسلسل العربي ، من اليمين الى اسفل ، ثم يُكمّل العمود الثاني من حيث انتهى الاول ، هكذا . فهنا يجب ان نقوم بمعالجة الموضوع بطريقتنا الخاصة استعنت بالبرنامج من الروابط اعلاه ، وعملت تجارب على عدة اعمدة: 2 الى 6 اعمدة ، وكتبت نتائجها في الاكسل ، لأرى النتائج بصورة مباشرة ، الحالي معناه ما يعطينا الاكسس ، والمفروض هو التسلسل الذي نسعى لعمله . وبعد التمعن في الارقام لعدة ايام ، توصلت الى ان هناك لوغاريثم معين يتماشى مع ارقام الاعمدة وتسلسلها ، وبعد تجربة عدة طرق توصلت لطريقة تعرض هذه الاعمدة بالطريقة التي نريدها 1. سنحتاج الى حقلين اضافيين في الجدول (لكل تقرير فرعي) ، حقل تسلسل الاعمدة (وسيكون مخفي ، باللون البرتقالي في الصورة ادناه) والذي سيعتمد عليه التقرير في فرز البيانات ، rpt2_Seq مثلا، وحقل للتسلسل الذي سنراه في التقرير ، Seq2 مثلا (الحقل الآخر في التقرير) ، 2. في التقرير ، هكذا نجعل فرز البيانات ، على اساس الحقل rpt2_Seq . وبما ان التقرير الرئيسي يحتوي على 3 تقارير فرعية (في برنامج الرابط اعلاه) ، . فوضعت الكود على حدث "التنسيق" لرأس التقرير Page Header ، وهذا هو الكود ، والذي نراه انه ينادي الدالة ("Call Seq_Records(2, "rpt2_Seq", "Seq2") ، لكل تقرير فرعي ، ويرسل عدد الاعمدة المطلوبة ، واسم حقلي التسلسل في الجدول للتقرير الفرعي: Option Compare Database Dim rst As DAO.Recordset Private Sub PageHeaderSection_Format(Cancel As Integer, FormatCount As Integer) 'Seq the subform Records 'rpt2 Set rst = CurrentDb.OpenRecordset("Select * From qry_2 Where nationalty=" & Me.nationalty) Call Seq_Records(2, "rpt2_Seq", "Seq2") 'rpt3 Set rst = CurrentDb.OpenRecordset("Select * From qry_3 Where nationalty=" & Me.nationalty) Call Seq_Records(2, "rpt3_Seq", "Seq3") 'rpt4 Set rst = CurrentDb.OpenRecordset("Select * From qry_4 Where nationalty=" & Me.nationalty) Call Seq_Records(2, "rpt4_Seq", "Seq4") End Sub . وهذا كود الدالة ، والتي يمكن إخراجها من التقرير وجعلها وحدة نمطية مستقلة) : Function Seq_Records(N As Integer, Seq_fName As String, Seq_n As String) On Error GoTo err_Seq_Records 'N = Number of columns 'Seq_fName = Seq Field Name 'Seq_n = Seq rst.MoveLast: rst.MoveFirst RC = rst.RecordCount c_Columns = N 'Number of columns in the report r_Records = RC 'Number of Records in the report j_First = c_Columns 'Start rtp_Seq with this number Counter = 0 'each time reduce c_Columns by this Counter For i = 1 To RC rst.Edit rst(Seq_fName) = j_First rst(Seq_n) = i 'Debug.Print "rtp_Seq=" & j_First & vbTab & "Seq=" & i rst.Update 'rtp_Seq j_First = j_First + c_Columns 'rpt_Seq cannot be > RC If j_First > RC Then 'start Counter Counter = Counter + 1 'rpt_Seq re-calculate j_First = c_Columns - Counter End If rst.MoveNext Next i Exit_Seq_Records: rst.Close: Set rst = Nothing Exit Function err_Seq_Records: If Err.Number = 3021 Then Resume Exit_Seq_Records Else MsgBox Err.Number & vbCrLf & Err.Description End If End Function . والنتيجة: . كما عملت تقرير للتجربة وبه 4 اعمدة ، والذي ينادي الدالة هكذا ("Call Seq_Records(4, "rpt2_Seq", "Seq2") ، والنتيجة . جعفر 680.4.الاجازات.accdb.zip

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