ابن بنها

جزيتم خيرا .. اين اضع هذا السطر Sub ToggleShowColumns() Columns("I:J").Hidden = Not Columns("I:J").Hidden CommandButton1.Caption = IIf(CommandButton1.Caption = "1", "2", "1") End Sub

اين الحبيب جزاكم الله خيرا

احمد الله الذي رزقني بك اخي الكريم عبد العزيز ابو العوافي وبعد لو تكرمت افتح الملف واضغط على زر اظهار السري وهو بدون كلمة سر اريد ان اجعل الكود الموجود يعمل بمتل هذه الطريقة جزاك الله خيرا

جزاك لله خيرا

منه لله اللي بيزيل مشاركات الناس بقول كده لان كان لي مشاركه كمان هنا ومشاركه في مكان اخر .. تمت ازالتهم طبعا من واحد متخيل انه صح وهو عين الخطأ منه لله

أخي وحبيبي ومعلمي وأستاذي عبد الله المجرب لكم اشتقنا لتواجدك فيما بيننا ، عوداً حميداً .. ونرجو منك التواصل معنا ولو 5 دقايق كل يوم

استاذ ياسر اصدقاءك كتير ومنهم اللي يجيد ذلك حلها الله يبارك لك

استاذ ياسر رجاء خاص لو سمحت عايز اربط بين الكود والفورمه الموجوده لانها مش راضيه تضبط

حاولت اجربها على ملف مش راضيه تشتغل ... حلها الله يبارك لك عايز حل ربط الفورمه مع الكود

اريدعدد الطلبه مشكورين يكون من خليه اس 1 ... في صفحة بيلنات المدرسه وجدت الحل sCont = Sheets("بيانات المدرسة").Range("B10") وجدت الحل sCont = Sheets("بيانات المدرسة").Range("B10")

Option Explicit ' اسماء المواد Const nTEST As String = "عريى" & "," & _ "رياضيات" & "," & _ "دراسات" & "," & _ "انجليزى" & "," & _ "علوم" & "," & _ "مجموع" & "," & _ "رسم" & "," & _ "العاب" & "," & _ "نشاط1" & "," & _ "نشلط 2" & "," & _ "دين" '-------------------------------------- ' ارقام اعمدة الدرجة الاصلية ' بالتسلسل حسب اسماء الموادوعددها Const ColmnTotal As String = "13,22,31,40,51,57,62,67,72,73,82" ' ارقام اعمدة الفصل الثاني 'ويجب ان يتساوى عددها 'مع عدد اسماء المواد 'لعليا التي كتبت ' وهنا المجموع ً Const ColmnTest2 As String = "9,18,27,36,47,54,59,64,69,73,77" ' رقم صف النهاية الصغرى Const iRs As Integer = 6 ' اول صف للبيانات Const TopRow As Integer = 7 Sub kh_Tgrba() Dim sCont As Integer, R As Integer Dim Tst As String On Error GoTo 0 '------------------ ' عدد الطلبة ' ممكن يؤخذ من خلية او يكتب كتابة sCont = 700 '--------------------------------------- Application.ScreenUpdating = False Application.Calculation = xlCalculationManual '------------------ sCont = sCont + TopRow With ActiveSheet For R = TopRow To sCont If Not IsEmpty(.Cells(R, "C")) Then Tst = kh_Test(R) '--متغير اســم ورقم العمود If Len(Tst) Then .Cells(R, "CW") = "له دور ثانى فى" Else .Cells(R, 101) = "ناجح" '--متغيررقم العمود .Cells(R, "CX") = kh_Test(R) End If Next End With 1: Application.ScreenUpdating = True Application.Calculation = xlCalculationAutomatic If Err Then MsgBox "Err.Number : " & Err.Number Err.Clear Else: MsgBox "تم اظهار النتيجة بنجاح" End If End Sub Function kh_Test(iRow As Integer) As String Dim vT, sT Dim NN As String, TT As String Dim ctlt As Integer, ctst As Integer Dim c As Integer, cc As Integer Dim ib As Boolean cc = UBound(Split(nTEST, ",")) For c = 0 To cc ib = False NN = Split(nTEST, ",")(c) ctlt = Split(ColmnTotal, ",")(c) ctst = Split(ColmnTest2, ",")(c) vT = Cells(iRow, ctlt) If Not IsEmpty(vT) Then Select Case vT Case Is = "غ", "غـ": ib = True Case Is < Cells(iRs, ctlt): ib = True End Select End If If ctst = 0 Then GoTo 1 sT = Cells(iRow, ctst) If Not IsEmpty(sT) Then Select Case sT Case Is = "غ", "غـ" NN = NN & " لثلث الدرجة": ib = True Case Is < Cells(iRs, ctst) NN = NN & " لثلث الدرجة": ib = True End Select End If 1: If ib Then TT = TT & IIf(Len(TT), " - ", "") & NN Next kh_Test = TT End Function ' عدد الطلبة ' ممكن يؤخذ من خلية او يكتب كتابة sCont = 700 اريدعدد الطلبه مشكورين يكون من خليه اس 1 ... في صفحة بيلنات المدرسه

لو سمحتم اريد شرح باقي الاكواد كما في الموديول سؤال ليه اول الكود سطره طويل جدا مش كنا بنعمله بسيط ياخد اسم الكود فقط مثلا Sub CopyRow فقط وايه فايدة الريسايز .. شكرا

ربنا يبارك لك يا استاذ الاساتذه سليم

ربنا يبارك في النافع

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

جزاك الله كل الخير

اريد ان احعل هذا في توقيعي .. كيف http://up.top4top.net/downloadf-top4...b00a1-rar.html خطوط البسمله http://up.top4top.net/downloadf-top4...ca0c1-rar.html خطوط الخطاط http://www.arfonts.net/?c=diwan&t=symbol خطوط الديواني http://www.arfonts.net/?c=thuluth خطوط الثلث http://www.arfonts.net/?c=naskh

رابط سيفيدك في عمل كنترول لمدرستك ودعواتنا للجميع بالخير http://www.officena.net/ib/profile/16499-%D8%B9%D8%A7%D8%AF%D9%84-%D8%AC%D9%84%D8%A7%D9%84/?do=content&page=1

نشكر الاخ النشيط ياسر لعمله الدي ندعو الله ان يجعله خالصا لوجه الله الكريم وبعد اخي ياسر ماهو القصور الذي وجدته في الداله الاولى خاصة الاستاذ عبد الله باقشير واين اضافتك ... لك شكري

Sub MacroFil1() Application.ScreenUpdating = False Sheets("بيانات الطلبة").Range("a7:o7").Select Selection.AutoFill Destination:=Range("a7:o" & ['الرئيسية'!s12] + 6) Sheets("رصد نصف العام").Select Range("a7:n7").Select Selection.AutoFill Destination:=Range("a7:n" & ['الرئيسية'!s12] + 6) Sheets("ملف الإنجاز1 ").Select Range("a7:k7").Select Selection.AutoFill Destination:=Range("a7:k" & ['الرئيسية''!s12] + 6) Sheets("رصد آخر العام ").Select Range("a7:cd7").Select Selection.AutoFill Destination:=Range("a7:cd" & ['الرئيسية'!s12] + 6) Sheets("بيانات الطلبة").Select Range("A4").Select Application.ScreenUpdating = True End Sub اخي الكريم ناصر سعيد وجدت الحل في احدى مشاركات الاخوة الكرام في هذا الرابط والكود المستخدم له فكره اخرى ولكن تؤدي نفس الغرض الذي تريده ان شاء الله Sub MacroFil1() Application.ScreenUpdating = False Sheets("بيانات الطلبة").Range("a7:o7").Select Selection.AutoFill Destination:=Range("a7:o" & ['الرئيسية'!s12] + 6) Sheets("رصد نصف العام").Select Range("a7:n7").Select Selection.AutoFill Destination:=Range("a7:n" & ['الرئيسية'!s12] + 6) Sheets("ملف الإنجاز1 ").Select Range("a7:k7").Select Selection.AutoFill Destination:=Range("a7:k" & ['الرئيسية''!s12] + 6) Sheets("رصد آخر العام ").Select Range("a7:cd7").Select Selection.AutoFill Destination:=Range("a7:cd" & ['الرئيسية'!s12] + 6) Sheets("بيانات الطلبة").Select Range("A4").Select Application.ScreenUpdating = True End Sub شرح للكود السطر الأول فى الكود هو اسم الماكرو السطر الثانى هو إلغاء تحديث الشاشة (الغاء مشاهدة تنفيذ الماكرو) السطر الثالث تحديد البيانات الموجودة فى أول صف من صفوف بيانات الطلاب من الخلية (a7)إلى الخلية (o7) السطر الرابع نسخ المعادلات والدوال الموجود فى المدى السابق بعدد الطلاب الموجود فى الصفحة الرئيسية من السطر الخامس حتى السطرالثالث عشر تكرار نفس عمليتى التحديد والنسخ فى الصفحات ( رصد نصف العام - ملف الإنجاز1 - رصد آخر العام ) حتى تكون الصفحات جاهزة لأستقبال وربط البيانات السطر الرابع عشر الرجوع إلى صفحة بيانات الطلبة السطر الخامس عشر الوقوف فى الخلبة (a4) السطر السادس عشر عكس السطر الثانى السطر السابع عشر نهاية الكود وحيث إنك من رجال التربية والتعليم أهديك هذا الكود وهو من تراث المنتدى الطيب برجاله Sub إظهار() Dim Answer As String Answer = InputBox(" فضلاَ أدخل كلمة المرور ") If Answer <> Sheets("بيانات الطلبة").Range("S2") Then MsgBox "كلمة المرور غير صحيحة ولم يتم تنفيذ المطلوب " Exit Sub End If MsgBox "كلمة المرور صحيحة وسيتم تنفيذ المطلوب " Columns("c:d").Select Selection.EntireColumn.Hidden = False Columns("s:s").Select Selection.EntireColumn.Hidden = True Range("b7").Select End Sub

جزاكم الله خيرا

الاستاذ الخلوق الصقر جزاك الله خيرا هذا الكود لانكتب في ارقام الجلوس اي معادله سريع جدا يظهر كل ارقام الجلوس مرة واحده فلا يرهق الطابعه اثناء الطباعه لانه عند طباعه ارقام الجلوس بفكرتك تجعل الطابعه تهنج جزاك الله كل خير

عشت يا إبن مصر .. عشت وعاش امثالك الذين يبتغون وجه الله في اعمالهم كرما منك اشرح الكود ظللت يومين اغير في الكود ولم اعرف التغيير فيه كيف اتي باسم رئيس الكنترول واسم ناظر المدرسه