كود طباعة الشهادات

[khairi ali]

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

اخواني الكرام اريد كود لطباعة لطباعة الشهائد

 لكم مني فائق التقدير والاحترام

طباعة الشهائد.xlsm

[Ali Mohamed Ali]

وعليكم السلام -كان عليك استخدام خاصية البحث بالمنتدى فبه طلبك-تفضل

كود طباعة الشهادات جميعها واخر لعدد محدد من الشهادات

طباعة الشهادات كلها بأمر واحد

[سليم حاصبيا]

1-تصغير الملف الى 20 - 40 اسم لا أكثر

تختار الأرقام من الخليتين B1 و  B2 (في حال الخطأ الماكرو ياخذ الأرقام من 1 الى عدد الطلاب)

2- في حال تريد طالباً واحداَ تكرر رقمه في B1 و  B2    مثلاً نريد الطالب رقم 5 نضع  5=B1 و  5=B2

يوجد صفحة مخفية لادراج الجداول (عدم المس بها لحسن سير عمل الماكرو)

جرب خذا الملف

Dim Mn%, Mx%, LR, k%, t%, i%
Dim ValA, ValB
Dim xx1%, xx2%
'++++++++++++++++++++++++++++++++
Rem Created By Salim Hasbaya On 20/11/2020
Sub CopY_rg(rg As Range, Where%)
rg.Copy
Saf.Range("A" & Where).PasteSpecial (xlPasteAll)
Application.CutCopyMode = False
End Sub
'++++++++++++++++++++++++++++++++
Sub fil_Rg()
Rem Created By Salim Hasbaya On 20/11/2020
LR = Fat.Cells(Rows.Count, 3).End(3).Row
If LR < 10 Then Exit Sub
xx1 = Val(Fat.Range("B1"))
xx2 = Val(Fat.Range("B2"))
ValA = IIf(xx1 <= 0, 1, Int(xx1))
ValB = IIf(xx2 <= 0, LR - 9, Int(xx2))

If ValA > LR - 9 Then ValA = 1
If ValB > LR - 9 Then ValB = LR - 9
Mn = Application.Min(ValA, ValB)
Mx = Application.Max(ValA, ValB)
Fat.Range("B1") = Mn: Fat.Range("B2") = Mx
t = Fat.Range("B2") - Fat.Range("B1") + 1
k = 1
Saf.Cells.Clear
For i = 1 To t
 Call CopY_rg(Source.Range("SPES_RG"), k)
 k = k + 18
 Next
 Saf.Rows.AutoFit
End Sub
'++++++++++++++++++++++++++++++++++
Sub Get_certificates()
Rem Created By Salim Hasbaya On 20/11/2020
fil_Rg
Dim Ro1%, Ro2%, Pos%
Dim y%, n%
Dim A1, A2, A3
A1 = Application.Transpose(Source.Range("Q1:AA1"))
A1 = Application.Transpose(A1)
A2 = Application.Transpose(Source.Range("Q2:AA2"))
A2 = Application.Transpose(A2)
A3 = Application.Transpose(Source.Range("Q3:AA3"))
A3 = Application.Transpose(A3)
Pos = 8
Ro1 = Fat.Range("B1") + 9
Ro2 = Fat.Range("B2") + 9
 For y = Ro1 To Ro2
   Saf.Cells(Pos - 6, 3) = Fat.Cells(y, 3)
 For n = LBound(A1) To UBound(A1)
  If Saf.Cells(Pos, 1) = "" Then Exit For
      Saf.Cells(Pos, 3).Offset(, n - 1) = _
         Fat.Cells(y, A1(n))
      Saf.Cells(Pos, 3).Offset(1, n - 1) = _
         Fat.Cells(y, A2(n))
      Saf.Cells(Pos, 3).Offset(2, n - 1) = _
         Fat.Cells(y, A3(n))
  Next n
  Pos = Pos + 18
 Next y
  Saf.PageSetup.PrintArea = Saf.Range("a1") _
 .Resize(Pos - 10, 14).Address
End Sub

 

Khiri.xlsm

[سليم حاصبيا]

الكود بتعامل مع اي عدد من الطلاب 

يمكنك اضافة ما تريد من اسماء

[khairi ali]

بارك الله فيك استاذي وان شاء الله في ميزان حسناتك