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

[طاهر اوفيسنا]

في 15‏/11‏/2025 at 18:45, kkhalifa1960 said:

تفضل هذا الكود مهما كان الهوامش .

DoCmd.OpenReport "اسم_التقرير", acViewPreview
DoCmd.PrintOut ac

اعتذرا لصاحب الموضوع وكي تعم الفائدة ممكن استاذ تعمل معروف وتزيد للكود طباعة الصفحة اي  نسخ الطباعة 3 مرات بزر واحد

تم تعديل الأربعاء at 08:48 بواسطه طاهر اوفيسنا

[Foksh]

منذ ساعه, طاهر اوفيسنا said:

3 مرات بزر واحد

 

اعتقد يمكن تحقيق ذلك من خلال استخدام OpenArgs كمتغير لعدد النسخ المستهدف طباعتها . وبالتالي نطبق فكرة الطباعة عند فتح التقرير بحيث يتم الطباعة مباشرةً بحلقة تكرارية لعدد مرات الطباعة عند فتح التقرير .

بحيث أولا نفتح التقرير من خلال زر ، مع تمرير قيمة المعامل OpenArgs وهنا سيكون 3 كمثال :-

DoCmd.OpenReport "اسم تقريرك", acViewNormal, , , , "3"

وداخل حدث عند فتح التقرير ، نحدد عدد الصفحات ( كما في المثال السابق ) الصفحة الأولى أو الحالية ، نستخدم الفكرة التالية :-

Private Sub Report_Open(Cancel As Integer)

    Dim c As Integer
    
    If Not IsNull(Me.OpenArgs) Then
        For c = 1 To Val(Me.OpenArgs) - 1
            DoCmd.PrintOut acPages, 1, 1
        Next c
    End If

End Sub

 

 

جرب وأخبرنا بالنتيجة

[منتصر الانسي]

لو رجعنا لتعليمات مايكروسوفت بخصوص الامر DoCmd.PrintOut على هذا الرابط سنجد أن صيغة هذا الأمر هي كالتالي

DoCmd.PrintOut (PrintRange, PageFrom, PageTo, PrintQuality, Copies, CollateCopies)

نلاحظ أنه يحتوي على المعلمة (Copies) والتي نحدد فيها عدد النسخ ولكن مع الأسف لا تعمل بشكل صحيح ولا ادري إذا ما كانت هذه المشكلة مرتبطة بنسخة الاوفيس لدي أم انها مشكلة عامة

حبيت اوضح هذه النقطة لتجربتها فإذا عملت لديكم كان بها وإلا فإن طريقة الاخ @Foksh قامت بمعالجة المشكلة 

تحياتي

[Foksh]

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

نلاحظ أنه يحتوي على المعلمة (Copies) والتي نحدد فيها عدد النسخ ولكن مع الأسف لا تعمل بشكل صحيح ولا ادري إذا ما كانت هذه المشكلة مرتبطة بنسخة الاوفيس لدي أم انها مشكلة عامة

 

كما تفضلتم أخي @منتصر الانسي تماماً ..

نجاح السطر الذي ارفقته وشاركته دليل على أنه أحد خصائص آكسيس التي يمكن من خلالها فعلاً تحديد عندد النسخ من خلال تمرير القيمة داخل سطر الإستدعاء . لكن يبدو من خلال بعض التجارب أن الأمر مرهون بعدة عوائق منها نوع الطابعة ، تعريف الطابعة نفسه ، نظام التشغيل الويندوز أو بمعنى ادق التحديثات التي تُـحدِثــُها مايكروسوفت . لذا توجهت فعلاً إلى استخدام أمر التكرار كحلقة لتكرار أمر الطباعة .

 

وهذا الموضوع الخارجي لتوسيع الفكرة لطباعة تقرير من خلال آكسيس .

[طاهر اوفيسنا]

في 19‏/11‏/2025 at 11:12, Foksh said:

جرب وأخبرنا بالنتيجة

لم افلح في التجربة استاذ اليك الكود عبر المفكرة txt حاول التعديل عليه

Prin3.rar

[Foksh]

4 ساعات مضت, طاهر اوفيسنا said:

لم افلح في التجربة استاذ اليك الكود عبر المفكرة txt حاول التعديل عليه

 

جرب هذا التعديل الجذري :-

Private Sub detaché_AfterUpdate()
On Error GoTo Err_detaché_Click

If IsNull(Me.TxtMonth) Then
    MsgBox "اختر الشهر"
    Exit Sub
End If

Dim Titles1 As Variant
Dim Titles2 As Variant

Titles1 = Array("مصالح البلدية", "متعاقدين 8 سا", "عمال متعاقدين 5 سا", "حراس متعاقدين 5 سا", "اعوان النظافة والتطهير")
Titles2 = Array("للعمال الموظفين", "للعمال المتعاقدين بالتوقيت الكامل", "للعمال المتعاقدين بالتوقيت الجزئي", "للحراس المتعاقدين بالتوقيت الجزئي", "للعمال اعوان النظافة والتطهير")

Dim idx As Long
idx = Me.detaché.ListIndex
If idx < 0 Then Exit Sub

Me.Reporte_Title.Visible = False
Me.Reporte_Title = Titles1(idx)
Me.Report_Title = Titles2(idx)

Dim Copies As Long
Copies = Nz(Me.txtCopies, 1)  ' يمكن ربطه بمربع نص في النموذج أو وضع رقم ثابت

DoCmd.OpenReport "rptDiscount", acPreview, , , , "qry_rptD|" & Copies

Exit Sub

Err_detaché_Click:
If Err.Number = 2501 Then Resume Next
End Sub

 

وداخل التقرير ، في حدث عند الفتح :-

Private Sub Report_Open(Cancel As Integer)
    Dim Args As Variant
    Dim QryName As String
    Dim Copies As Long
    Dim i As Long
    
    If Not IsNull(Me.OpenArgs) Then
        Args = Split(Me.OpenArgs, "|")
        QryName = Args(0)
        If UBound(Args) >= 1 Then
            Copies = Val(Args(1))
        Else
            Copies = 1
        End If
        For i = 2 To Copies
            DoCmd.PrintOut acPages, 1, 1
        Next i
    End If

End Sub

 

[طاهر اوفيسنا]

16 دقائق مضت, Foksh said:

جرب هذا التعديل الجذري :-

ياريت يكون في ملف استاذ لاني نتصل بالمبايل وليس لي القدرة على نسخ الكود

[Foksh]

18 دقائق مضت, طاهر اوفيسنا said:

ياريت يكون في ملف

تفضل

 

Prin3.zip

[طاهر اوفيسنا]

10 دقائق مضت, Foksh said:

تفضل

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

[Foksh]

لو أنك قرأت التعليق أخي طاهر ..

استبدل الجزء :-

Nz(Me.txtCopies, 1)

برقم يمثل عدد النسخ التي تريد طباعتها .

[طاهر اوفيسنا]

منذ ساعه, Foksh said:

لو أنك قرأت التعليق أخي طاهر ..

اي تعليق استاذ !!!

 

منذ ساعه, Foksh said:

Nz(Me.txtCopies, 1)

مالذي تغير ؟

[Foksh]

3 ساعات مضت, طاهر اوفيسنا said:

اي تعليق استاذ !!!

 

التعليق الموجود بجانب السطر الذي ظهر عنده الخطأ . تركته لك لتمكينك وتخييرك بإدخال قيمة عدد النسخ بشكل يدوي من خلال مربع نص ، أو تستبدل الجزء بقيمة رقمية ثابتة لعدد النسخ .

على العموم ، استبدل الجزء بأي رقم تريده ليكون عدد النسخ ، فقط لا غير .

[طاهر اوفيسنا]

Nz(txtCopies, 3)

تقصد يكون هكذا استاذ

8 ساعات مضت, Foksh said:

على العموم ، استبدل الجزء بأي رقم تريده ليكون عدد النسخ ، فقط لا غير .

 

[طاهر اوفيسنا]

16 ساعات مضت, Foksh said:

Titles1 = Array("مصالح البلدية", "متعاقدين 8 سا", "عمال متعاقدين 5 سا", "حراس متعاقدين 5 سا", "اعوان النظافة والتطهير")

ثانيا كيف استبدل التسميات ب Titles1=Array(Me.Reporte_Title.ItemData(0,1,2,3,4))

[Foksh]

5 ساعات مضت, طاهر اوفيسنا said:

Nz(txtCopies, 3)

تقصد يكون هكذا استاذ

 

Private Sub detaché_AfterUpdate()
On Error GoTo Err_detaché_Click

If IsNull(Me.TxtMonth) Then
    MsgBox "اختر الشهر"
    Exit Sub
End If

Dim Titles1 As Variant
Dim Titles2 As Variant

Titles1 = Array("مصالح البلدية", "متعاقدين 8 سا", "عمال متعاقدين 5 سا", "حراس متعاقدين 5 سا", "اعوان النظافة والتطهير")
Titles2 = Array("للعمال الموظفين", "للعمال المتعاقدين بالتوقيت الكامل", "للعمال المتعاقدين بالتوقيت الجزئي", "للحراس المتعاقدين بالتوقيت الجزئي", "للعمال اعوان النظافة والتطهير")

Dim idx As Long
idx = Me.detaché.ListIndex
If idx < 0 Then Exit Sub

Me.Reporte_Title.Visible = False
Me.Reporte_Title = Titles1(idx)
Me.Report_Title = Titles2(idx)

Dim Copies As Long
Copies = 3  ' يمكن ربطه بمربع نص في النموذج أو وضع رقم ثابت

DoCmd.OpenReport "rptDiscount", acPreview, , , , "qry_rptD|" & Copies

Exit Sub

Err_detaché_Click:
If Err.Number = 2501 Then Resume Next
End Sub

 

واعتذر عن المتابعة ، لأسباب صحية 

[Lamyaa]

إضافة إلى ما ذكره الأساتذة

 

يمكنك استخدام هذه الدالة:

Public Function PrintMultipleCopies(strReportName As String, _
                                    bytNumberOfCopies As Byte)
    Dim bytCounter As Byte
    For bytCounter = 1 To bytNumberOfCopies
        DoCmd.OpenReport strReportName
    Next bytCounter
End Function

وطريقة الاستدعاء:

Call PrintMultipleReports("[اسم التقرير]", 2) ' حاليا تم التعيين نسختين ويمكنك التعديل حسب ما تريد

 

[Foksh]

8 دقائق مضت, Lamyaa said:

إضافة إلى ما ذكره الأساتذة

 

يمكنك استخدام هذه الدالة:

Public Function PrintMultipleCopies(strReportName As String, _
                                    bytNumberOfCopies As Byte)

وطريقة الاستدعاء:

Call PrintMultipleReports("[اسم التقرير]", 2)

 

شكراً للمشاركة الخفيفة .. ولي تعليقان ، قد يكون الأول سهواً أو خطأ مطبعي . وهو أن الإستدعاء ليس صحيحاً باسم الدالة المرفقة .

ثانياً الدالة ستقوم بفتح التقرير ، ولكن ليس هناك أي أمر طباعة . وأفترض أنه قد يكون التعديل الصحيح للفكرة :-

Public Function PrintMultipleCopies(strReportName As String, _
                                    bytNumberOfCopies As Byte)
    Dim i As Integer
    For i = 1 To bytNumberOfCopies
        DoCmd.OpenReport strReportName, acViewNormal
    Next i
End Function

 

والإستدعاء :-

Call PrintMultipleCopies("اسم التقرير", 2)

حيث هنا عدد النسخ المطلوب طباعتها = 2 

[Lamyaa]

خطأ مطبعي 

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

[طاهر اوفيسنا]

47 دقائق مضت, Lamyaa said:

خطأ مطبعي 

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

1 ساعه مضت, Foksh said:

واعتذر عن المتابعة ، لأسباب صحية 

 

تم تعديل منذ 11 دقائق بواسطه طاهر اوفيسنا

[Lamyaa]

هذا هو التطبيق

PrintMultipleCopies.accdb