خالد_محمد قام بنشر ديسمبر 12, 2008 مشاركة قام بنشر ديسمبر 12, 2008 السلام عليكم هل يوجد اختصار لهاذا الكود الذي بالاسفل ليسهل التعامل معه عند ما يكون عدد الطلاب كبير جداً مثلاً لو وصل عدد الطلاب 300 طالب Sub طباعة_السجلات_التدريبي_المحددة() 'تابع لسجل التدريبي If Range("DD73") = 0 Then MsgBox "أختر الطالب أو مجموعة الطلاب الذين تريد طباعة سجلات التدريب لهم وأضغط على الزر مرة أخرى " Exit Sub End If If Range("DG80") = True Then Range("AP1").Value = 1 ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True End If If Range("DG81") = True Then Range("AP1").Value = 2 ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True End If If Range("DG82") = True Then Range("AP1").Value = 3 ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True End If If Range("DG83") = True Then Range("AP1").Value = 4 ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True End If If Range("DG84") = True Then Range("AP1").Value = 5 ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True End If If Range("DG85") = True Then Range("AP1").Value = 6 ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True End If If Range("DG86") = True Then Range("AP1").Value = 7 ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True End If If Range("DG87") = True Then Range("AP1").Value = 8 ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True End If If Range("DG88") = True Then Range("AP1").Value = 9 ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True End If If Range("DG89") = True Then Range("AP1").Value = 10 ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True End If If Range("DG90") = True Then Range("AP1").Value = 11 ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True End If If Range("DG91") = True Then Range("AP1").Value = 12 ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True End If If Range("DG92") = True Then Range("AP1").Value = 13 ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True End If If Range("DG93") = True Then Range("AP1").Value = 14 ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True End If If Range("DG94") = True Then Range("AP1").Value = 15 ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True End If If Range("DG95") = True Then Range("AP1").Value = 16 ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True End If If Range("DG96") = True Then Range("AP1").Value = 17 ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True End If If Range("DG97") = True Then Range("AP1").Value = 18 ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True End If If Range("DG98") = True Then Range("AP1").Value = 19 ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True End If If Range("DG99") = True Then Range("AP1").Value = 20 ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True End If If Range("DG100") = True Then Range("AP1").Value = 21 ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True End If If Range("DG101") = True Then Range("AP1").Value = 22 ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True End If If Range("DG102") = True Then Range("AP1").Value = 23 ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True End If If Range("DG103") = True Then Range("AP1").Value = 24 ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True End If If Range("DG104") = True Then Range("AP1").Value = 25 ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True End If If Range("DG105") = True Then Range("AP1").Value = 26 ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True End If If Range("DG106") = True Then Range("AP1").Value = 27 ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True End If If Range("DG107") = True Then Range("AP1").Value = 28 ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True End If If Range("DG108") = True Then Range("AP1").Value = 29 ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True End If If Range("DG109") = True Then Range("AP1").Value = 30 ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True End If Range("A1").Select End Sub وشكراً جزيلاً مقدماً KH_MH.rar رابط هذا التعليق شارك More sharing options...
احمدزمان قام بنشر ديسمبر 12, 2008 مشاركة قام بنشر ديسمبر 12, 2008 السلام عليكم و رحمة الله وبركاته كل عام وانتم بخير اخي الفاضل اذا تكرمت جرب المرفق ان شاء الله يكون هذا المطلوب وان كان غير ذلك فضلا ولو تكرمت اعلمني هنا لنتمكن من التعديل مع التحية و التقدير احمد يعقوب زمان KH_MH.rar KH_MH.rar رابط هذا التعليق شارك More sharing options...
خالد_محمد قام بنشر ديسمبر 12, 2008 الكاتب مشاركة قام بنشر ديسمبر 12, 2008 السلام عليكم اخي احمد يعقوب شكراًً للمساعدة واسف على التاخير الجهاز هنق معاي اخي بعد التجربة لم ينجح الكود . اذا اخترت طلاب غير مرتبين مثلاً اخترت الطالب رقم 6 و 12 و 14 مثلا يطبعلي الطالب رقم 1 و الطالب رقم 2 والطالب رقم 3 وهاكذا وشكراً لك رابط هذا التعليق شارك More sharing options...
احمدزمان قام بنشر ديسمبر 13, 2008 مشاركة قام بنشر ديسمبر 13, 2008 السلام عليكم و رحمة الله وبركاته السبت، 15/12/1429هـ. الموافق 13/12/08م معليش ياعم سامحنا جل من لايخطيء سبحانة وتعالى استبدل الكود بالكود التالي الذي تم تعديلة Sub ØÈÇÚÉ_ÇáÓÌáÇÊ_ÇáÊÏÑíÈí_ÇáãÍÏÏÉ() 'ÊÇÈÚ áÓÌá ÇáÊÏÑíÈí If Range("DD73") = 0 Then MsgBox "ÃÎÊÑ ÇáØÇáÈ Ãæ ãÌãæÚÉ ÇáØáÇÈ ÇáÐíä ÊÑíÏ ØÈÇÚÉ ÓÌáÇÊ ÇáÊÏÑíÈ áåã æÃÖÛØ Úáì ÇáÒÑ ãÑÉ ÃÎÑì " Exit Sub End If [AP1] = 1 For AH = 80 To 999 If Cells(AH, "DG") = True Then ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True End If [AP1] = [AP1] + 1 Next Range("A1").Select End Sub آمل تجربته واخباري بالنتيجة مع التحية و التقدير رابط هذا التعليق شارك More sharing options...
احمدزمان قام بنشر ديسمبر 13, 2008 مشاركة قام بنشر ديسمبر 13, 2008 السلام عليكم و رحمة الله وبركاته السبت، 15/12/1429هـ. الموافق 13/12/08م هذا الملف بعد التعديل KH_MH.rar رابط هذا التعليق شارك More sharing options...
خالد_محمد قام بنشر ديسمبر 13, 2008 الكاتب مشاركة قام بنشر ديسمبر 13, 2008 السلام عليكم أخي احمد نسامحك على ايش ؟ الخطأ وارد في كُل شي بس انت اتحملنا شوي على كثرة الأسئلة . الكود يعمل بنجاح ولكن فيه ملاحظة بسيطة وهي عند اختيار طالب او اكثر فأنه يعرض جميع ارقام الطلاب بالخلية [AP1] هل بالإمكان ان يعرض الأرقام المطلوب طباعتها فقط بالخلية [AP1] ويتجاوز باقي الارقام لتي لم نحددها لطباعة مثل طريقة عمل الكود الذي كان مع البرنامج أخي احمد جزأك الله ألف خير ونفع بعلمك الجميع وجعله الله في موازين حسناتك رابط هذا التعليق شارك More sharing options...
احمدزمان قام بنشر ديسمبر 13, 2008 مشاركة قام بنشر ديسمبر 13, 2008 السلام عليكم و رحمة الله وبركاته السبت، 15/12/1429هـ. الموافق 13/12/08م اخي الفاضل ابو محمد تم تعديل الكود بحيث يتم نقل الرقم الموجود امام الإسم الى الخلية AP1 قبل عملية الطباعة ثم تتم الطباعة فضلا جرب المرفق واعلمني هل هذا المطلوب او لا مع التحية و التقدير KH_MH5.rar رابط هذا التعليق شارك More sharing options...
خالد_محمد قام بنشر ديسمبر 14, 2008 الكاتب مشاركة قام بنشر ديسمبر 14, 2008 السلام عليكم اخى ابو يعقوب الله يسعدك في الدارين ويزيدك علماً الكود يعمل بكفائة وهذا المطلوب بل اكثر شكراً لك . مع تحياتي وتقديري رابط هذا التعليق شارك More sharing options...
احمدزمان قام بنشر ديسمبر 14, 2008 مشاركة قام بنشر ديسمبر 14, 2008 اخي ابو محمد جزاك الله خيرا ونحن في خدمة الطيبين شرواك انا وجميع اخواني و اساتذتي في المنتدى رابط هذا التعليق شارك 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.