ابن بنها قام بنشر أكتوبر 5, 2017 مشاركة قام بنشر أكتوبر 5, 2017 ملف التطبيق http://www.mediafire.com/file/yr1rrb7... رابط هذا التعليق شارك More sharing options...
ابن بنها قام بنشر أكتوبر 5, 2017 الكاتب مشاركة قام بنشر أكتوبر 5, 2017 يظهر عندي هذه الصوره عند فتح الملف ... لماذا ارجوكم ؟ =========== اريد رفع الملف مضبوطا على موقع اخر او على المنتدى افضل رابط هذا التعليق شارك More sharing options...
ابن بنها قام بنشر أكتوبر 6, 2017 الكاتب مشاركة قام بنشر أكتوبر 6, 2017 ربنا يبارك فيكم يارب رابط هذا التعليق شارك More sharing options...
ناصر سعيد قام بنشر أكتوبر 6, 2017 مشاركة قام بنشر أكتوبر 6, 2017 الله يسعد ايامكم وايامنا يارب هذا هو الملف وهذا هو الكود Sub sajida() '=================== 'هذا الكود للنابغه ساجدة العزاوي 'الهدف من الكود هو استخراج وطباعه شهادات الناجحين 'كل 4 شهادات في صفحه واحده 'تم هذا الكود في 6/10/2017 '=*=*=*=*=*=*=* Dim SHehada As Worksheet, DATA As Worksheet, Z As Range Set DATA = Worksheets("رصد الترم الثانى") 'اسم شيت قاعدة البيانات Set SHehada = Worksheets("4شهادات") 'اسم الشيت الخاص بالشهادات Dim myArray, targt targt = "ناج*" 'خلية البحث Set Z = SHehada.Range("M3") '=================== c = 0 Application.ScreenUpdating = False lr = DATA.Cells(Rows.Count, 2).End(xlUp).Row 'اخر صف به بيانات ' عدد الصفوف الخارجة عن التوزيع في ورقة مصدر البيانات For i = 7 To lr '======= If DATA.Cells(i, 101) Like targt & "*" And c = 0 Then ' If (DATA.Cells(i, 101) = "ناجــــح" Or DATA.Cells(i, 101) = "ناجحــــة") And c = 0 Then Z = DATA.Cells(i, 2) c = c + 1 '=== ' ElseIf (DATA.Cells(i, 101) Like "*" & "ناج" & "*" And c = 1 Then ElseIf DATA.Cells(i, 101) Like targt & "*" And c = 1 Then SHehada.Range("M19") = DATA.Cells(i, 2) c = c + 1 ' ElseIf (DATA.Cells(i, 101) = "ناجــــح" Or DATA.Cells(i, 101) = "ناجحــــة") And c = 2 Then ElseIf DATA.Cells(i, 101) Like targt & "*" And c = 2 Then SHehada.Range("M35") = DATA.Cells(i, 2) c = c + 1 ' ElseIf (DATA.Cells(i, 101) = "ناجــــح" Or DATA.Cells(i, 101) = "ناجحــــة") And c = 3 Then ElseIf DATA.Cells(i, 101) Like targt & "*" And c = 3 Then SHehada.Range("M51") = DATA.Cells(i, 2) c = c + 1 End If If i = lr And c = 4 Then SHehada.Range("a1:p63").PrintOut: Exit For If i = lr And c = 3 Then SHehada.Range("a1:p47").PrintOut: Exit For If i = lr And c = 2 Then SHehada.Range("a1:p31").PrintOut: Exit For If i = lr And c = 1 Then SHehada.Range("a1:p15").PrintOut: Exit For If i < lr And (SHehada.Range("M19") = "" Or SHehada.Range("M35") = "" Or SHehada.Range("M51") = "") Then GoTo 1 If i < lr And c = 4 Then SHehada.Range("a1:p63").PrintOut c = 0 Z = "" SHehada.Range("M19") = "" SHehada.Range("M35") = "" SHehada.Range("M51") = "" 1: Next i Z = "" SHehada.Range("M19") = "" SHehada.Range("M35") = "" SHehada.Range("M51") = "" Application.ScreenUpdating = True End Sub '=*=*=**=*=*=*=*=* ================================ http://gulfup.co/itpyj0db0zzp ================================ رابط اخر https://up.top4top.net/downloadf-644qz4ck1-rar.html رابط هذا التعليق شارك 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.