رجاء فحص الكود التالى كتحسين له

[أحمد العيسى]

السلام عليكم

الكود التالى يعمل بدون مشاكل

ولكن هناك سطور مكررة متداخلة به

طلبى من السادة الزملاء ضبط البناء لاختصاره وتحسينه

Private Sub cmdPrint_Click()
On Error GoTo Err_cmdPrint_Click

Dim Index3 As Variant
Dim repName  As String
  For Each Index3 In L3.ItemsSelected
    repName = L3.ItemData(Index3)
    repName = "تقرير_" & repName
  Next Index3
   If repName = "" Then
    MsgBox "لا يوجد مطبوغات قد تم اختيارها", vbInformation + vbMsgBoxRight, "تنبيه "
    Exit Sub
  Else
    
  For Each Index3 In L3.ItemsSelected
    repName = L3.ItemData(Index3)
    repName = "تقرير_" & repName
    DoCmd.OpenReport repName, acViewNormal, , ftrName
  Next Index3
Exit_cmdPrint_Click:
    Exit Sub

Err_cmdPrint_Click:
    MsgBox Err.Description
    Resume Exit_cmdPrint_Click
 End If
End Sub

 

تم تعديل منذ 4 ساعات بواسطه أحمد العيسى

[Moosak]

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

باستخدام هذه الأداة : 

Private Sub cmdPrint_Click()
    On Error GoTo Err_cmdPrint_Click

    Dim Index3 As Variant
    Dim repName As String
    Dim ftrName As String ' Declare ftrName, assuming it's a String for the filter argument.

    ' Check if any items are selected from the listbox.
    If L3.ItemsSelected.Count = 0 Then
        MsgBox "لا يوجد مطبوغات قد تم اختيارها", vbInformation + vbMsgBoxRight, "تنبيه "
        Exit Sub
    End If

    ' Loop through each selected item and open the corresponding report.
    For Each Index3 In L3.ItemsSelected
        repName = L3.ItemData(Index3)
        repName = "تقرير_" & repName
        DoCmd.OpenReport repName, acViewNormal, , ftrName
    Next Index3

Exit_cmdPrint_Click:
    Exit Sub

Err_cmdPrint_Click:
    MsgBox Err.Description
    Resume Exit_cmdPrint_Click
End Sub

مع اختيار :

والتعليمات نفس رسالتك مع تغيير بسيط :

الكود التالى يعمل بدون مشاكل

ولكن هناك سطور مكررة متداخلة به

يرجى ضبط بناء الكود لاختصاره وتحسينه

[Debug Ace]

منذ ساعه, أحمد العيسى said:

الكود التالى يعمل بدون مشاكل

ولكن هناك سطور مكررة متداخلة به

طلبى من السادة الزملاء ضبط البناء لاختصاره وتحسينه

اتفضل
 

Private Sub cmdPrint_Click()
    On Error GoTo Err_Handler

    Dim idx      As Variant
    Dim repName  As String
    Dim ftrName  As String 

    If L3.ItemsSelected.Count = 0 Then
        MsgBox "لا يوجد مطبوعات قد تم اختيارها", vbInformation + vbMsgBoxRight, "تنبيه"
        Exit Sub
    End If

    For Each idx In L3.ItemsSelected
        repName = "تقرير_" & L3.ItemData(idx)
        DoCmd.OpenReport repName, acViewNormal, , ftrName
    Next idx

Exit_Handler:
    Exit Sub

Err_Handler:
    Select Case Err.Number
        Case 2501   ' المستخدم ألغى الطباعة
            Resume Next
        Case Else
            MsgBox "خطأ " & Err.Number & ":" & vbCrLf & Err.Description, vbExclamation, "خطأ"
            Resume Exit_Handler
    End Select
End Sub

 

[أحمد العيسى]

تمام  .. كل الشكر لكما

وهذا  ما تم تنقيحه ليكون نهائياً

' طباعة المحدد
Private Sub cmdPrint_Click()
    On Error GoTo Err_cmdPrint_Click

    Dim Index3 As Variant
    Dim repName As String
   
    ' فحص إذا كان هناك بند تم تحديده
    If L3.ItemsSelected.Count = 0 Then
        MsgBox "لا يوجد مطبوعات قد تم اختيارها", vbInformation + vbMsgBoxRight, "تنبيه "
        Exit Sub
    End If

    ' المرور على كل عنصر محدد وفتح التقرير المقابل له
    For Each Index3 In L3.ItemsSelected
        repName = L3.ItemData(Index3)
        repName = "تقرير_" & repName
        DoCmd.OpenReport repName, acViewNormal, , ftrName
    Next Index3

Exit_cmdPrint_Click:
    Exit Sub

Err_cmdPrint_Click:
    MsgBox Err.Description
    Resume Exit_cmdPrint_Click
End Sub

أما عن  هذا السطر

Private ftrName As String

فقد تم التصريح به فى بداية  VBA

سؤالى هنا :

ما هو   ftrName

هل هو  أمر  محجوز للطباعة

[Foksh]

3 دقائق مضت, أحمد العيسى said:

أما عن  هذا السطر

Private ftrName As String

فقد تم التصريح به فى بداية  VBA

سؤالى هنا :

ما هو   ftrName

هل هو  أمر  محجوز للطباعة

سؤالك جميل وفي محله 👏🏻

[Debug Ace]

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

أما عن  هذا السطر

Private ftrName As String

فقد تم التصريح به فى بداية  VBA

سؤالى هنا :

ما هو   ftrName

تم تعريفه كـ String فارغ مما يعني فتح التقرير بدون أي فلتر (كل البيانات)

وظيفته:
DoCmd.OpenReport repName, acViewNormal, , ftrName
WhereCondition — شرط SQL لتصفية البيانات

 

أمثلة عملية:

• فتح التقرير بدون فلتر (كل البيانات)

ftrName = ""

 

• فلترة بمدينة معينة

ftrName = "City = 'Cairo'"

 

• فلترة بتاريخ

ftrName = "OrderDate = #" & Date & "#"

 

• فلترة بـ ID من النموذج

ftrName = "CustomerID = " & Me.txtCustomerID

 

في هذا الكود تحديدا

ftrName معرف لكنه فارغ  >>--> يعني التقرير يفتح بكل البيانات بدون تصفية

إذا كنت تريد تصفية التقارير قم بوضعه باسناد البيانات التى تريدها الى المتغير حسب نوع البيانات قبل الحلقة:
استخدم احد الفلاتر التى قمت بشرحها لك سابقا كأمثلة عملية قبل الحلقة مباشرة 

تم تعديل منذ 1 ساعه بواسطه Debug Ace