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

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

السلام عليكم

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

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

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

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

 

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

[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