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

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

السلام عليكم

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

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

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

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

 

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

[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

مع اختيار :

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

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

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

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