إختصار كود

[توكل]

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

إخوتي الأحبة هل بالإمكان إختصار هذا الكود

عفوا لا أدري كيف يمكن تعريب الرسالة والتي هي: لايمكن الطباعة لوجود خانات فارغة

Private Sub Workbook_BeforePrint(Cancel As Boolean)
    If Range("L9").Value = "" Then
        MsgBox "ÚÐÑÇ áä ÊÊã ÇáØÈÇÚÉ áæÌæÏ ÎÇäÇÊ ÝÇÑÛÉ íÌÈ Ãä ÊÚÈÃ"
        Cancel = True
   Range("L9").Select
   End If
          If Range("L10").Value = "" Then
        MsgBox "ÚÐÑÇ áä ÊÊã ÇáØÈÇÚÉ áæÌæÏ ÎÇäÇÊ ÝÇÑÛÉ íÌÈ Ãä ÊÚÈÃ"
        Cancel = True
   Range("L10").Select
   End If
         If Range("L11").Value = "" Then
        MsgBox "ÚÐÑÇ áä ÊÊã ÇáØÈÇÚÉ áæÌæÏ ÎÇäÇÊ ÝÇÑÛÉ íÌÈ Ãä ÊÚÈÃ"
        Cancel = True
   Range("L11").Select
   End If
         If Range("L12").Value = "" Then
        MsgBox "ÚÐÑÇ áä ÊÊã ÇáØÈÇÚÉ áæÌæÏ ÎÇäÇÊ ÝÇÑÛÉ íÌÈ Ãä ÊÚÈÃ"
        Cancel = True
   Range("L12").Select
   End If
         If Range("L13").Value = "" Then
        MsgBox "ÚÐÑÇ áä ÊÊã ÇáØÈÇÚÉ áæÌæÏ ÎÇäÇÊ ÝÇÑÛÉ íÌÈ Ãä ÊÚÈÃ"
        Cancel = True
   Range("L13").Select
   End If
         If Range("L14").Value = "" Then
        MsgBox "ÚÐÑÇ áä ÊÊã ÇáØÈÇÚÉ áæÌæÏ ÎÇäÇÊ ÝÇÑÛÉ íÌÈ Ãä ÊÚÈÃ"
        Cancel = True
   Range("L14").Select
    End If
     If Range("L15").Value = "" Then
        MsgBox "ÚÐÑÇ áä ÊÊã ÇáØÈÇÚÉ áæÌæÏ ÎÇäÇÊ ÝÇÑÛÉ íÌÈ Ãä ÊÚÈÃ"
        Cancel = True
   Range("L15").Select
    End If
     If Range("L16").Value = "" Then
        MsgBox "ÚÐÑÇ áä ÊÊã ÇáØÈÇÚÉ áæÌæÏ ÎÇäÇÊ ÝÇÑÛÉ íÌÈ Ãä ÊÚÈÃ"
        Cancel = True
   Range("L16").Select
    End If
     If Range("L17").Value = "" Then
        MsgBox "ÚÐÑÇ áä ÊÊã ÇáØÈÇÚÉ áæÌæÏ ÎÇäÇÊ ÝÇÑÛÉ íÌÈ Ãä ÊÚÈÃ"
        Cancel = True
   Range("L17").Select
   End If
   If Range("L18").Value = "" Then
        MsgBox "ÚÐÑÇ áä ÊÊã ÇáØÈÇÚÉ áæÌæÏ ÎÇäÇÊ ÝÇÑÛÉ íÌÈ Ãä ÊÚÈÃ"
        Cancel = True
   Range("L18").Select
   End If
   If Range("L19").Value = "" Then
        MsgBox "ÚÐÑÇ áä ÊÊã ÇáØÈÇÚÉ áæÌæÏ ÎÇäÇÊ ÝÇÑÛÉ íÌÈ Ãä ÊÚÈÃ"
        Cancel = True
   Range("L19").Select
   End If
   If Range("I28").Value = "" Then
        MsgBox "ÚÐÑÇ áä ÊÊã ÇáØÈÇÚÉ áæÌæÏ ÎÇäÇÊ ÝÇÑÛÉ íÌÈ Ãä ÊÚÈÃ"
        Cancel = True
   Range("I28").Select
   End If
   If Range("I29").Value = "" Then
        MsgBox "ÚÐÑÇ áä ÊÊã ÇáØÈÇÚÉ áæÌæÏ ÎÇäÇÊ ÝÇÑÛÉ íÌÈ Ãä ÊÚÈÃ"
        Cancel = True
   Range("I29").Select
   End If
   If Range("I30").Value = "" Then
        MsgBox "ÚÐÑÇ áä ÊÊã ÇáØÈÇÚÉ áæÌæÏ ÎÇäÇÊ ÝÇÑÛÉ íÌÈ Ãä ÊÚÈÃ"
        Cancel = True
   Range("I30").Select
   End If
   If Range("I31").Value = "" Then
        MsgBox "ÚÐÑÇ áä ÊÊã ÇáØÈÇÚÉ áæÌæÏ ÎÇäÇÊ ÝÇÑÛÉ íÌÈ Ãä ÊÚÈÃ"
        Cancel = True
   Range("I31").Select
   End If
   If Range("I32").Value = "" Then
        MsgBox "ÚÐÑÇ áä ÊÊã ÇáØÈÇÚÉ áæÌæÏ ÎÇäÇÊ ÝÇÑÛÉ íÌÈ Ãä ÊÚÈÃ"
        Cancel = True
   Range("I32").Select
   End If
   If Range("I33").Value = "" Then
        MsgBox "ÚÐÑÇ áä ÊÊã ÇáØÈÇÚÉ áæÌæÏ ÎÇäÇÊ ÝÇÑÛÉ íÌÈ Ãä ÊÚÈÃ"
        Cancel = True
   Range("I33").Select
   End If
   If Range("I34").Value = "" Then
        MsgBox "ÚÐÑÇ áä ÊÊã ÇáØÈÇÚÉ áæÌæÏ ÎÇäÇÊ ÝÇÑÛÉ íÌÈ Ãä ÊÚÈÃ"
        Cancel = True
   Range("I34").Select
   End If
   If Range("I36").Value = "" Then
        MsgBox "ÚÐÑÇ áä ÊÊã ÇáØÈÇÚÉ áæÌæÏ ÎÇäÇÊ ÝÇÑÛÉ íÌÈ Ãä ÊÚÈÃ"
        Cancel = True
   Range("I36").Select
      Else
        ActiveWindow.SelectedSheets.PrintOut Copies:=1 ', Preview:=True
    End If

End Sub

 

[عبدالسلام ابوالعوافي]

جرب

Private Sub Workbook_BeforePrint(Cancel As Boolean)
    Dim i As Integer
    For i = 9 To 19: If Cells(i, "L") = "" Then GoTo a
    Next i
    For i = 28 To 34: If Cells(i, "L") = "" Then GoTo a
    Next i
    i = 36: If Cells(i, "L") = "" Then GoTo a
    ActiveWindow.SelectedSheets.PrintOut Copies:=1 ', Preview:=True
    Exit Sub
a:
    MsgBox "عذرا لن تتم الطباعة لوجود خانات فارغة يجب أن تعبأ": Cancel = True: Cells(i, "L").Select
End Sub

 

تم تعديل أكتوبر 19, 2016 بواسطه عبدالسلام ابوالعوافي

[توكل]

2 ساعات مضت, عبدالسلام ابوالعوافي said:

عذرا

جزاك الله خيراً فعلاً حقق المطلوب ولكن هل بالامكان الوقوف على آخر خلية فارغة ؟

[عبدالسلام ابوالعوافي]

الكود اعلاه يقف علي اول خلية فارغة وكنت اعتقد هذا الاصوب .. جرب الكود الاتي لعله يفي بالغرض

Private Sub Workbook_BeforePrint(Cancel As Boolean)
    Dim i As Integer
    Dim ii As Integer
    ii = 0
    For i = 9 To 19: If Cells(i, "L") = "" Then ii = i
    Next i
    For i = 28 To 34: If Cells(i, "L") = "" Then ii = i
    Next i
    i = 36: If Cells(i, "L") = "" Then ii = i
    If ii > 0 Then GoTo a
    ActiveWindow.SelectedSheets.PrintOut Copies:=1 ', Preview:=True
    Exit Sub
a:
    MsgBox "عذرا لن تتم الطباعة لوجود خانات فارغة يجب أن تعبأ": Cancel = True: Cells(ii, "L").Select

End Sub

 

[توكل]

احسن الله إليك وزادك علما