توكل قام بنشر أكتوبر 19, 2016 مشاركة قام بنشر أكتوبر 19, 2016 السلام عليكم ورحمة الله وبركاته إخوتي الأحبة هل بالإمكان إختصار هذا الكود عفوا لا أدري كيف يمكن تعريب الرسالة والتي هي: لايمكن الطباعة لوجود خانات فارغة 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 رابط هذا التعليق شارك More sharing options...
عبدالسلام ابوالعوافي قام بنشر أكتوبر 19, 2016 مشاركة قام بنشر أكتوبر 19, 2016 (معدل) جرب 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 بواسطه عبدالسلام ابوالعوافي رابط هذا التعليق شارك More sharing options...
توكل قام بنشر أكتوبر 19, 2016 الكاتب مشاركة قام بنشر أكتوبر 19, 2016 2 ساعات مضت, عبدالسلام ابوالعوافي said: عذرا جزاك الله خيراً فعلاً حقق المطلوب ولكن هل بالامكان الوقوف على آخر خلية فارغة ؟ رابط هذا التعليق شارك More sharing options...
عبدالسلام ابوالعوافي قام بنشر أكتوبر 21, 2016 مشاركة قام بنشر أكتوبر 21, 2016 الكود اعلاه يقف علي اول خلية فارغة وكنت اعتقد هذا الاصوب .. جرب الكود الاتي لعله يفي بالغرض 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 رابط هذا التعليق شارك More sharing options...
توكل قام بنشر أكتوبر 21, 2016 الكاتب مشاركة قام بنشر أكتوبر 21, 2016 احسن الله إليك وزادك علما رابط هذا التعليق شارك More sharing options...
الردود الموصى بها
Join the conversation
You can post now and register later. If you have an account, sign in now to post with your account.