khairi ali قام بنشر نوفمبر 20, 2020 مشاركة قام بنشر نوفمبر 20, 2020 السلام عليكم ورحمة الله وبركاته اخواني الكرام اريد كود لطباعة لطباعة الشهائد لكم مني فائق التقدير والاحترام طباعة الشهائد.xlsm رابط هذا التعليق شارك More sharing options...
Ali Mohamed Ali قام بنشر نوفمبر 20, 2020 مشاركة قام بنشر نوفمبر 20, 2020 وعليكم السلام -كان عليك استخدام خاصية البحث بالمنتدى فبه طلبك-تفضل كود طباعة الشهادات جميعها واخر لعدد محدد من الشهادات طباعة الشهادات كلها بأمر واحد 2 رابط هذا التعليق شارك More sharing options...
أفضل إجابة سليم حاصبيا قام بنشر نوفمبر 20, 2020 أفضل إجابة مشاركة قام بنشر نوفمبر 20, 2020 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 1 1 رابط هذا التعليق شارك More sharing options...
سليم حاصبيا قام بنشر نوفمبر 22, 2020 مشاركة قام بنشر نوفمبر 22, 2020 الكود بتعامل مع اي عدد من الطلاب يمكنك اضافة ما تريد من اسماء 1 رابط هذا التعليق شارك More sharing options...
khairi ali قام بنشر نوفمبر 22, 2020 الكاتب مشاركة قام بنشر نوفمبر 22, 2020 بارك الله فيك استاذي وان شاء الله في ميزان حسناتك 1 رابط هذا التعليق شارك More sharing options...
الردود الموصى بها
من فضلك سجل دخول لتتمكن من التعليق
ستتمكن من اضافه تعليقات بعد التسجيل
سجل دخولك الان