السلام عليكم ورحمة الله وبركاته وبها نبدأ اي موضوع
إخواني أعضاء المنتدي الكرام بعد سلام الله عليكم ورحمة الله وبركاته
الكود هذا يطبع 8بطاقات الجلوس للمدرسة في كل ورقة
ولكن فيه خطأ وعايز اصححه
الخطأ : عند الطباعة يطبع كل الأوراق ولكن في آ خر ورقة يطبع بطاقة واحدة من 8
وأنا عايزة يطبع كل البطاقات لاخر بطاقة
وشكرا جزيلا لأعضاء المنتدي الكرام الذين تعلمت منهم الكثير
'هذا الكود للنابغه ساجده العزاوي
' وهي من أهلنا بالعراق أعز الله العراق وأذل أعداءه
'تم في اكتوبر 2017
'كمعطيات المحترم ابو أحمد محمدي
'الهدف من الكود هو استخراج الشهادات
'كل 3 شهادات في صفحه واحدة
'بثلاث معايير
'=*=*=*=*=*
Dim SHEHADA As Worksheet, DATA As Worksheet
Dim myArray, targt, targt2 As String
'اسم صفحة المصدر
Set DATA = Worksheets("ص")
'اسم صفحة الهدف
Set SHEHADA = Worksheets("جلوس جميع الصفوف")
'===================
' targt3 = "5/1"
targt = SHEHADA.Range("M13").Value & "*"
'===================
C = 0
Application.ScreenUpdating = False
lr = DATA.Cells(Rows.Count, 2).End(xlUp).Row 'اخر صف به بيانات
' عدد الصفوف الخارجة
'عن التوزيع في ورقة مصدر البيانات
'هذا السطر في حال شهادات الكل
'هذا السطر في حال طلب شهادات محدده
' For i = sh4.Cells(7, 18).Value To sh4.Cells(7, 19).Value
For i = SHEHADA.[M4].Value To SHEHADA.[N4].Value
'=======
If DATA.Cells(i, 7) Like targt & "*" And C = 0 Then
Range("D2") = DATA.Cells(i, 2)
C = C + 1
ElseIf DATA.Cells(i, 7) Like targt & "*" And C = 1 Then
Range("J2") = DATA.Cells(i, 2)
C = C + 1
ElseIf DATA.Cells(i, 7) Like targt & "*" And C = 2 Then
Range("D15") = DATA.Cells(i, 2)
C = C + 1
ElseIf DATA.Cells(i, 7) Like targt & "*" And C = 3 Then
Range("J15") = DATA.Cells(i, 2)
C = C + 1
ElseIf DATA.Cells(i, 7) Like targt & "*" And C = 4 Then
Range("D28") = DATA.Cells(i, 2)
C = C + 1
ElseIf DATA.Cells(i, 7) Like targt & "*" And C = 5 Then
Range("J28") = DATA.Cells(i, 2)
C = C + 1
ElseIf DATA.Cells(i, 7) Like targt & "*" And C = 6 Then
Range("D41") = DATA.Cells(i, 2)
C = C + 1
ElseIf DATA.Cells(i, 7) Like targt & "*" And C = 7 Then
Range("J41") = DATA.Cells(i, 2)
C = C + 1
' ElseIf DATA.Cells(i, 101) Like targt & "*" And DATA.Cells(i, 104) Like targt2 & "*" And DATA.Cells(i, 103) Like targt3 & "*" And c = 3 Then
' SHEHADA.Range("M51") = DATA.Cells(i, 2)
' c = c + 1
'===
End If
If i = SHEHADA.[N4] And C = 8 Then SHEHADA.Range("G41:K53").PrintOut: Exit For
If i = SHEHADA.[N4] And C = 7 Then SHEHADA.Range("A41:F53").PrintOut: Exit For
If i = SHEHADA.[N4] And C = 6 Then SHEHADA.Range("G28:K39").PrintOut: Exit For
If i = SHEHADA.[N4] And C = 5 Then SHEHADA.Range("A28:F39").PrintOut: Exit For
If i = SHEHADA.[N4] And C = 4 Then SHEHADA.Range("G15:K26").PrintOut: Exit For
If i = SHEHADA.[N4] And C = 3 Then SHEHADA.Range("A15:F26").PrintOut: Exit For
If i = SHEHADA.[N4] And C = 2 Then SHEHADA.Range("G1:K13").PrintOut: Exit For
If i = SHEHADA.[N4] And C = 1 Then SHEHADA.Range("A1:F13").PrintOut: Exit For
If i < SHEHADA.[N4] And (Range("D41") = "" Or Range("J41") = "") Then GoTo 1
If i < SHEHADA.[N4] And C = 8 Then SHEHADA.Range("A1:K53").PrintOut
C = 0
Range("D2") = ""
Range("J2") = ""
Range("D15") = ""
Range("J15") = ""
Range("D28") = ""
Range("J28") = ""
Range("D41") = ""
Range("J41") = ""
' Range("M51") = ""
1:
Next i
Range("D2") = ""
Range("J2") = ""
Range("D15") = ""
Range("J15") = ""
Range("D28") = ""
Range("J28") = ""
Range("D41") = ""
Range("J41") = ""
' Range("M51") = ""
Application.ScreenUpdating = True
End Sub
عند وضع كود يتم وضع عن طريق ايقونه الكود وهى
<>
يرجي ارفاق ملف
