عبدالله باقشير

السلام عليكم ينفع ثلاث شهادات

السلام عليكم تفضل المرفق table_1.rar

السلام عليكم خلايا اسم المدرس مدموجة هل تحتاج هذا الدمج ؟؟؟

السلام عليكم نعم لانه لا يحسب القيم الخارجة عن النطاق لذا يجب اضافة الحد الاقصى للسجلات التي يمكن ان تكون موجودة مستقبلا هما الاتنتان يقومان بالجمع اذا استخدمت رقم 9 او 109 للدالة SUBTOTAL ولكن الدالة SUBTOTAL لها خاصية معينة اقرأ التعليمات SUBTOTAL انظر أيضاً إرجاع مجموع فرعي في إحدى القوائم أو قواعد البيانات. بوجه عام، من السهل إنشاء قائمة بمجموع فرعي باستخدام مجاميع فرعية (القائمة بيانات بمجرد إنشاء قائمة المجموع الفرعي، يمكنك تعديلها بواسطة تحرير الدالة SUBTOTAL. بناء الجملة SUBTOTAL(function_num, ref1, ref2, ...) Function_num (رقم الدالة) الأرقام من 1 إلى 11 (بما في ذلك القيم المخفية) أو 101 إلى 111 (تجاهل القيم المخفية) والتي تحدد الدالة التي تستخدم في حساب المجاميع الفرعية داخل القائمة. (بما في ذلك القيم المخفية)-------- (تجاهل القيم المخفية) -----------------------الدالة 1 ---------------------------------------- 101 ----------------------------------- AVERAGE 2 ----------------------------------------- 102 ------------------------------------- COUNT 3 ---------------------------------------- 103 ------------------------------------- COUNTA 4 ----------------------------------------- 104 ------------------------------------- MAX 5 ---------------------------------------- 105 ------------------------------------- MIN 6 ---------------------------------------- 106 ----------------------------------- PRODUCT 7 ----------------------------------------- 107 ------------------------------------- STDEV 8 ---------------------------------------- 108 ------------------------------------- STDEVP 9 ---------------------------------------- 109 ---------------------------------------- SUM 10 -------------------------------------- 110 ---------------------------------------- VAR 11 --------------------------------------- 111 ---------------------------------------- VARP هي النطاقات أو المراجع من 1 إلى 29 التي تريد المجموع الفرعي لها. ملاحظات إذا كان هناك مجاميع فرعية أخرى داخل ref1, ref2, (أو مجاميع فرعية متداخلة)، يتم تجاهل المجاميع الفرعية المتداخلة هذه لكي يتم تجنب العد المزدوج. بالنسبة لثوابت function_num من 1 إلى 11، تتضمن الدالة SUBTOTAL قيم الصفوف المخفية بواسطة الأمر إخفاء تحت القائمة الفرعية صف في القائمة تنسيق). استخدم هذه الثوابت عندما تريد للمجموع الفرعي ارقام مخفية وغير مخفية في القائمة. بالنسبة لثوابت function_Num من 10 إلى 11، تتجاهل دالة SUBTOTAL قيم الصفوف المخفية بواسطة الأمر إخفاء في القائمة الفرعية صف من القائمة تنسيق). استخدم هذه الثوابت عندما تريد المجموع الفرعي للأرقام المخفية في القائمة. تتجاهل الدالة SUBTOTAL اية صفوف غير مضمنة في ناتج التصفية، بغض النظر عن قيمة function_num التي تستخدمها. تم تصميم الدالة SUBTOTAL لاعمدة البيانات، أو النطاقات الرأسية. ولم يتم تصميمها لصفوف البيانات، أو النطاقات الأفقية. على سبيل المثال، عند حساب المجموع الفرعي لنطاقات أفقية باستخدام function_num لـ 101 أو أكبر، بالشكل SUBTOTAL(109,B2:G2)، لا يؤثر إخفاء أحد الأعمدة على المجموع الفرعي، ولكن يؤثر إخفاء أي من الصفوف في النطاق الرأسي على المجموع الفرعي. إذا كانت أي من المراجع عبارة عن مراجع ثلاثية الأبعاد، تقوم SUBTOTAL بإرجاع القيمة الخطأ !VALUE#.

السلام عليكم تفضل المرفق table.rar

السلام عليكم الاخ /ابن النيل--------------حفظه الله هل ستحتاج في عملك الى اضافة 7500 دائرة اعمل بيانات اقرب الى الواقع حتى تتاكد بشكل قطعي ============= الاخ /قصي--------------حفظه الله تم عمل الشهادات وكشوفات الناجحين ودورثاني راجع المرفق ________________________________3.rar

السلام عليكم بالمعادلات =INDEX(المادة;MATCH($C$10;INDEX(الاحد;0;B$4);0)) تفضل المرفق table.rar

السلام عليكم تفضل المرفق bosh.rar

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

السلام عليكم تفضل المرفق ________________1___6.rar

السلام عليكم ورحمة الله وبركاته الاخ/SAM ------------حفظه الله ============================================ تعليمة WITH ======== تسمح هذه التعليمة بالتاثيرعل الغرض عدة مرات باستدعاء اسمه مرة واحدة مثلا هذا الكود Y = ActiveSheet.UsedRange.Rows.Count ActiveSheet.PageSetup.PrintArea = "$B$3:$T$" & Y استخدمنا الغرض ActiveSheet مرتين عند استخدام WITH With ActiveSheet Y = .UsedRange.Rows.Count .PageSetup.PrintArea = "$B$3:$T$" & Y End With =========================================== اذا اردنا اسناد غرض الى متحول Objest نستخدم set مثلا: Set MyRng = Range("n12:dg60") =========================================== الاخ/dvb------------حفظه الله باستخدام التصفية Sub kh_Filter() Dim MyRng As Range Dim XX As Integer, ZZ As Integer With ورقة1 XX = .Range("A" & .Rows.Count).End(xlUp).Row Set MyRng = .Range("A1:B" & XX) End With With ورقة2 ZZ = Application.CountA(.Range("A1:A20")) MyRng.AdvancedFilter Action:=xlFilterCopy _ , CriteriaRange:=.Range("A1:A" & ZZ) _ , CopyToRange:=.Range("D1:E1"), Unique:=True End With End Sub تفضل المرفق Book1.rar

السلام عليكم ISRA انظر الى الرابط: بخصوص ساعات بصيغة الفلاش http://www.officena.net/ib/index.php?showtopic=27879&hl= ======================================= الاخ / ابن النيل ---------------حفظه الله تفضل كود اضافة الشهادات مع الدوائر مع ضبط اعدادات تحضير الشهادات للطباعة شهادة في كل ورقة Sub KH_ADD_S() Dim MyRng As Range, MyCell As Range Dim X As Integer, R As Integer, Y As Integer Set MyRng = ورقة1.Range("A12:DL51") Set MyCell = Range("نموذج_الشهادة") KH_Clear Application.ScreenUpdating = False X = 25 MyCell.Copy For R = 1 To MyRng.Rows.Count - 1 Range("B" & X).PasteSpecial xlPasteAll X = X + 22 Next R X = 12 With MyRng For R = 1 To .Rows.Count Range("F" & X) = .Range("H" & R) Range("P" & X) = .Range("B" & R) Range("E" & X + 7) = .Range("DK" & R) Range("J" & X + 7) = .Range("DL" & R) Range("D" & X + 5).RowHeight = 33 For C = 4 To 19 .Cells(R, Cells(1, C)).Copy Cells(X + 5, C).Select ActiveSheet.Paste Selection.PasteSpecial xlPasteValues Next C X = X + 22 Next R With ActiveSheet Y = .UsedRange.Rows.Count .PageSetup.PrintArea = "$B$3:$T$" & Y End With End With Application.CutCopyMode = False Application.ScreenUpdating = True End Sub هذا كود حذف الدوائر والشهادات Sub KH_Clear() Dim shp As Shape, Y As Integer Application.ScreenUpdating = False With ActiveSheet .Range("F12:L12,P12:Q12,D17:S17,E19:H19,J19:S20").ClearContents Y = .UsedRange.Rows.Count + 25 .Rows("25:" & Y).Delete .PageSetup.PrintArea = Range("نموذج_الشهادة").Address End With For Each shp In ActiveSheet.Shapes If shp.AutoShapeType = msoShapeOval Then shp.Delete Next shp ActiveWindow.ScrollRow = 1 End Sub تفضل المرفق ___________________________1.rar

السلام عليكم تطبيق التنسيق الجديد وايضا باضافة الدوائر ========================= مع استخراج حالة الطالب و مواد دور ثاني عند اضافتك للدوائر ========================= تم التطبيق على ثلاث مواد(عربي /انجليزي/ رياضيات) هل هناك مواد اخرى؟؟؟ ========================= كم تريد شهادات في ورقة الطباعة انظر الى تنسيق الشهادة او غير ما تريده حسب ما تريد ========================= اريد اجابات بالتفصيل الممل لو تكرمت ________________________________2.rar

السلام عليكم Sub KH_START() Dim MyRng As Range Dim O As Integer, XX As Integer, R As Integer, RR As Integer Set MyRng = Range("A2:A20") Range("D2:E1000").ClearContents O = 2 With æÑÞÉ1 XX = .Range("A" & .Rows.Count).End(xlUp).Row For R = 2 To XX For RR = 1 To Application.CountA(MyRng) If .Cells(R, 2) = MyRng.Cells(RR, 1) Then Cells(O, 4) = .Cells(R, 1) Cells(O, 5) = .Cells(R, 2) O = O + 1 End If Next RR Next R End With End Sub تفضل المرفق Book1.rar

السلام عليكم الاخ / قصي ممكن ملف فيه بيانات اقرب الى الواقع ( بالنسبة للدرجات) حتى نستطيع التطبيق بشكل مثالي وبالنسبة للشهادات ممكن رقم عمود المادة مثلا نشاطات من اي عمود توخذ؟؟؟

السلام عليكم في الورقة شهادة واحدة فقط ام عدة شهادات؟؟ اذا كان حسب المرفق استخدم الكود: Sub test2() Dim MyArray Dim MyCell As Range Dim V As Shape Dim X As Integer Dim C As Integer dell ' مسح الدوائر '================================================ MyArray = Array("اللغة العربية", "انجليزى", "الدراسات", "الرياضيات", "العلوم", "رسم", "المجموع", "دين") '================================================ X = ActiveWindow.Zoom Application.ScreenUpdating = False ActiveWindow.Zoom = 100 For C = 0 To 7 Set MyCell = Cells(12, C + 3) If MyCell.Offset(2, 0).Value = MyArray(C) Then Set V = ActiveSheet.Shapes.AddShape(msoShapeOval, MyCell.Left + 1, MyCell.Top + 1, MyCell.Width - 2, MyCell.Height - 2) V.Fill.Visible = msoFalse V.Line.ForeColor.SchemeColor = 10 V.Line.Weight = 1.25 End If Next ActiveWindow.Zoom = X Application.ScreenUpdating = True MsgBox "تم إضافة الدوائر بنجاح", vbMsgBoxRtlReading, "الحمدلله" End Sub ================================================ اذا كانت عدة شهادات سنضيف في الكود FOR ---NEXT لصفوف الشهادات المتبقية حسب شرط معين سنضيفه في احدى خلايا صف الدرجات ================================================ ___________________.rar

السلام عليكم اخي الفاضل / mafwz----------حفظه الله ولك بمثل دعائك اضعاف مضاعفة اكرمك الله اخي الفاضل / AAA7373----------حفظه الله ولك بمثل دعائك اضعاف مضاعفة اكرمك الله تقبلوا تحياتي وشكري

السلام عليكم استبدل هذا الكود في فورم الاستيراد Sub KHCOPYMYRANGE_Click() On Error Resume Next Dim MySheet As Workbook Dim M As Integer, N As Integer, NN As Integer, C As Integer Dim lRows As Integer If RefEdit1.Text = "" Then GoTo 1 On Error GoTo 1 kh_focopy.Hide Application.ScreenUpdating = False Application.Calculation = xlManual With Range([RefEdit1]) M = .Rows.Count For lRows = 1 To M If .Cells(lRows, 1) <> "" Then '======================================================= ' كل صفين يتم اضافة البيانات N = N + 2 '======================================================= ' تسلسل البيانات المرحلة NN = N / 2 MyCell.Cells(N, 1) = NN + Last_Count '======================================================= ' سلسلة اعمدة البيانات تمتد من 1 الى 92 بداية من عمود الاسماء For C = 1 To 92 ' ترحيل البيانات MyCell.Cells(N, C + 1) = .Cells(lRows, C) Next C '======================================================= End If Next lRows End With '======================================================= MsgBox "تم استيراد عدد " & Chr(32) & NN & Chr(32) & " من السجلات بنجاح", 524288 + vbMsgBoxRtlReading, "الحمدلله" '======================================================= Application.Calculation = xlAutomatic Application.ScreenUpdating = True Mybook.Activate End GoTo 2 1: MsgBox "استخدام خاطىء", 524288, "تنبيه" On Error GoTo 0 2 End Sub

السلام عليكم عفوا اخي عصام بعد اعادة تشغيل الاكسبورت استطعت تحميل المرفقات

السلام عليكم الروابط هذه لا تعمل عندي

السلام عليكم في الملف 3489 في خلايا الاعمدة S,N من تنسيق ---حماية--- ابعد التحفيز في (مخفية) ====================================== وتم الاعتماد على العمود الاول في تسلسل الصفوف واختيار آخر صف في الملفين الورقة "عام" ====================================== يتم اخذ اسم الملف الذي ستستورد منه البيانات من الخلية filname ====================================== كود الاستيراد: Sub KH_START() On Error Resume Next Dim Mybook As Workbook Dim N As String, R As Long, RR As Long Dim MyRang_1 As Range, MyRang_2 As Range N = Range("filname") RR = Range("A" & Rows.Count).End(xlUp).Row + 1 Set Mybook = Workbooks(N) With Mybook.Worksheets("عام") R = .Range("A" & .Rows.Count).End(xlUp).Row Set MyRang_1 = .Range("A2:X" & R) Set MyRang_2 = .Range("R2:S" & R) End With Application.ScreenUpdating = False MyRang_1.Copy Range("A" & RR).PasteSpecial xlPasteValues Application.CutCopyMode = False MyRang_2.Copy Range("R" & RR).PasteSpecial xlPasteFormulas Application.CutCopyMode = False Application.ScreenUpdating = True On Error GoTo 0 End Sub ==================================== كود استدعاء البيانات في ورقة"البضائع المستلمة" Sub استدعاء() On Error Resume Next Dim X As Long, R As Long Dim M As Integer, C As Integer, CC As Integer Range("B9:F28").ClearContents M = 9 Application.ScreenUpdating = False With ورقة1 X = .Range("A" & .Rows.Count).End(xlUp).Row For R = 5 To X If .Cells(R, "Q") = [E6] And .Cells(R, "C") <> "" Then For C = 1 To 5 CC = Choose(C, 3, 4, 5, 10, 15) Cells(M, C + 1) = .Cells(R, CC) Next C M = M + 1 End If Next R End With Application.ScreenUpdating = True MsgBox "تم استدعاء " & M - 9 & " سجلات", vbMsgBoxRight, "الحمد لله" On Error GoTo 0 End Sub تفضل المرفق ________________.rar

السلام عليكم لو تلاحظ لما تعمل لصق كلي ينقل المعادلات في كل خلية ويعمل ارتباطات للمعادلات للملف الناسخ وهذا خطا واذا قمنا بلصق جزئي العائق دمج الخلايا واذا استخدمنا for ----next العائق الدمج وخلو بعض الخلايا من البيانات

السلام عليكم اخي والله حاولت اشتغل في ملفاتك ولكن هناك مشكلة لعملية لصق البيانات المرحلة في الكود والسبب الدمج الحاصل للخلايا في ملفاتك و بسبب الدمج ايضا لا اقدر احصل على آخر خلية في الصف ====================== ناسف شديدا لعدم تقديمنا اي خدمة لك

السلام عليكم الاستاذ/ عادل جمال------------------حفظه الله عمل رائع ومتعوب فيه اخي الكريم بارك الله فيك

السلام عليكم استخدم and =IF(AND(D3>=$D$2;D4>=$D$2;C4>=$C$2);0;1)