اذهب الي المحتوي
بحث مخصص من جوجل فى أوفيسنا
Custom Search

ناصر سعيد

05 عضو ذهبي
  • Content count

    1,553
  • تاريخ الانضمام

  • تاريخ اخر زياره

السمعه بالموقع

211 Excellent

3 متابعين

عن العضو ناصر سعيد

  • الرتبه
    ناصر سعيد

Profile Information

  • Gender (Ar)
    ذكر
  • Job Title
    teacher

اخر الزوار

1,050 زياره للملف الشخصي
  1. ربنا يحفظكم ويبارك فيكم لجميع من واساني
  2. اضافه صف تحت الصفوف في صفحات

    هذا هو الكود الذي هداني به المحترم الاستاذ بن عليه حفظه الله ورعاه وهو خاص بنسخ صفوف اسفل الصفوف المنسوخه 'هذا الكود للمحترم ياسر العربي ' الهدف من الكود هو نسخ صف الى صفوف تحته بالعدد المطلوب 'بدون مسح البيانات القديمه 'تاريخ الانشاء 30/7/2017 'تم التعديل بواسطه المحترم الخلوق بن عليه حاجي '=*=*=*=*=*=*=*=*=*=*=*=*=*=* Private Sub CommandButton1_Click() Dim sh As Worksheet, lr As Long, str As String If TextBox1.Text = Sheets("بيانات الطلبة").Range("F1") Then Me.Hide TextBox1.Text = "" MsgBox "كلمة المرور صحيحة و سيتم تنفيذ المطلوب" Application.ScreenUpdating = False Application.Calculation = xlCalculationManual 'اذا كان عدد المتقدمين اقل من اتنين يتم ايقاف الكود ولا يكمل If Sheets("بيانات الطلبة").Range("Q1") < 2 Then Exit Sub End If '=*=*=*=*=*=* For Each sh In Sheets(Array("بيانات الطلبة", "إنجاز1", "تحريرى ف 1", "تحريرى ف 2", "أعمال السنة", "كشف ناجح", "الحاله", "كنترول شيت", "رصد الترم الثانى", "كنترول شيت (2)", "رصد الترم الأول", "كشف الدور الثاني")) '--------------------------------------------------------------------------------------- 'lr = sh.Range("B" & sh.Range("b10000").End(xlUp).Row).Row lr = sh.Range("A" & sh.Range("A10000").End(xlUp).Row).Row '--------------------------------------------------------------------------------------- sh.Activate '======================== ' str المتغير دا يتم تخزين اسم العمود الاخير فيه للعمل عليه 'يتم الذهاب الى اخر عمود بالاعتماد على الصف السادس ويتم استخلاص اسم العمود من اسم النطاق str = Split(sh.Range("HH9").End(xlToLeft).Address, "$")(1) ' نسخ الصف السابع لكل شيت من حيث عدد الاعمدة الى العدد المحدد بعدد المتقدمين '--------------------------------------------------------------------------------------- Set Rng = Range("A" & lr + IIf(lr = 9, 0, 1) & ":" & str & ['بيانات الطلبة'!Q1] + lr - IIf(lr = 9, 1, 0)) sh.Range("A9:" & str & 9).Copy Destination:=Rng '--------------------------------------------------------------------------------------- Next Sheets("بيانات الطلبة").Select Range("A4").Select Application.Calculation = xlCalculationAutomatic Application.ScreenUpdating = True Unload Me Else MsgBox "عفوا كلمة المرور خاطئة و لن يتم تنفيذ المطلوب" TextBox1.Text = "" TextBox1.SetFocus End If End Sub Private Sub UserForm_Click() End Sub '===================================
  3. شرح عمل الشهادات للنابغه ساجده العزاوي ================= رابط ملف التطبيق http://www.mediafire.com/file/jdte1oy
  4. اضافه صف تحت الصفوف في صفحات

    للرفع لننهي الاعمال على خير ان شاء الله
  5. بسم الله الرحمن الرحيم احبابنا في الله كم كنت اتمنى ان يستمر عطائي لكم بان اجمع واهذب الاكواد التي اعتبرها كنوز لرجالات التربيه والتعليم ولكن انتقل اخي الحبيب الاستاذ الجليل سعيد .. الى رحاب الله فتغيرت الدنيا معي ولهذا قررت ان اختم اعمالي في هذا المنتدى الراق باهله بهذا العمل واجعله رحمة ونورا لاخي واطلب منكم ان تدعو لاخي بالرحمة والمغره وان يسكنه الله فسيح جناته .. باخلاص فسياتي وقت نكون نحن فيه احوج الى هذا الدعاء ساكمل ان شاء الله في وقت اخر لظروف خارجه عن ارادتي
  6. للرفع رفع الله مقداركم
  7. اكواد رائعه خاصه بعمل الكنترول في ملف اكواد رائعه.rar
  8. المرفق النهائي الذي ينسخ الصفوف بالعدد في عده صفحات مختلفه من ملف بسهوله ويسر وذلك بعد مسح البيانات القديمه وهو طبعا لخليفه العلامه عبد الله باقشير المحترم ياسر العربي وتعديل العبقري ياسر خليل وسبب التعديل ادخال جزئيه جديده لعمليه مسح البيانات القديمه نسخ 1صفوف.rar وهذا هو الكود المرفق بالملف لمن اراد الاستمتاع بالكنوز 'هذا الكود للمحترم ياسر العربي ' الهدف من الكود هو نسخ صف الى صفوف تحته بالعدد المطلوب 'وقبل النسخ يتم مسح البيانات القديمه 'تاريخ الانشاء 30/7/2017 'تم التعديل على الكود بواسطه المحترم ياسر خليل لوجود متطلبات جديده '=*=*=*=*=*=*=*=*=*=*=*=*=*=* Private Sub CommandButton1_Click() Dim ws As Worksheet Dim sh As Worksheet Dim lr As Long Dim lc As Long Dim c As Long Set ws = Sheets("بيانات الطلبة") c = ws.Range("C2").Value If TextBox1.Text = ws.Range("F1") Then Me.Hide TextBox1.Text = "" MsgBox "كلمة المرور صحيحة و سيتم تنفيذ المطلوب", 64 Application.ScreenUpdating = False Application.Calculation = xlManual 'اذا كان عدد المتقدمين اقل من اتنين يتم ايقاف الكود ولا يكمل If ws.Range("C2") < 2 Then Exit Sub End If For Each sh In Sheets(Array("بيانات الطلبة", "إنجاز1", "تحريرى ف 1", "تحريرى ف 2", "أعمال السنة", "كشف الدور الثاني", "رصد الترم الثانى", "كشف ناجح")) lr = IIf(LastOccupiedRowNum(sh) = 7, 7, LastOccupiedRowNum(sh)) lc = LastOccupiedColNum(sh) 'حذف البيانات الموجودة في النطاق المحدد sh.Range("A8").Resize(Rows.Count - 7, lc).Clear 'نسخ الصف السابع لكل شيت من حيث عدد الاعمدة الى العدد المحدد بعدد المتقدمين sh.Range("A7").Resize(1, lc).AutoFill Destination:=sh.Range("A7").Resize(c, lc) Next sh Application.Goto ws.Range("A1") Application.Calculation = xlAutomatic Application.ScreenUpdating = True Unload Me Else MsgBox "عفواً كلمة المرور خاطئه و لن يتم تنفيذ المطلوب", vbExclamation TextBox1.Text = "" TextBox1.SetFocus End If End Sub Public Function LastOccupiedRowNum(Sheet As Worksheet) As Long Dim lng As Long If Application.WorksheetFunction.CountA(Sheet.Cells) <> 0 Then With Sheet lng = .Cells.Find(What:="*", After:=.Range("A1"), Lookat:=xlPart, LookIn:=xlFormulas, SearchOrder:=xlByRows, SearchDirection:=xlPrevious, MatchCase:=False).Row End With Else lng = 1 End If LastOccupiedRowNum = lng End Function Public Function LastOccupiedColNum(Sheet As Worksheet) As Long Dim lng As Long If Application.WorksheetFunction.CountA(Sheet.Cells) <> 0 Then With Sheet lng = .Cells.Find(What:="*", After:=.Range("A1"), Lookat:=xlPart, LookIn:=xlFormulas, SearchOrder:=xlByColumns, SearchDirection:=xlPrevious, MatchCase:=False).Column End With Else lng = 1 End If LastOccupiedColNum = lng End Function '================================== Private Sub UserForm_Click() End Sub جزى الله كل من كان له بصمه في اخراج هذا العمل الى النور
  9. هذا هو المرفق النهائي الذي ينسخ الصفوف بالعدد في عده صفحات مختلفه من ملف بسهوله ويس وذلك بعد مسح البيانات القديمه وهو طبعا لخليفه العلامه عبد الله باقشير المحترم ياسر العربي وتعديل العبقري ياسر خليل وسبب التعديل ادخال جزئيه جديده لعمليه مسح البيانات القديمه نسخ 1صفوف.rar وهذا هو الكود المرفق بالملفلمن اراد الاستمتاع بالكنوز 'هذا الكود للمحترم ياسر العربي ' الهدف من الكود هو نسخ صف الى صفوف تحته بالعدد المطلوب 'وقبل النسخ يتم مسح البيانات القديمه 'تاريخ الانشاء 30/7/2017 'تم التعديل على الكود بواسطه المحترم ياسر خليل لوجود متطلبات جديده '=*=*=*=*=*=*=*=*=*=*=*=*=*=* Private Sub CommandButton1_Click() Dim ws As Worksheet Dim sh As Worksheet Dim lr As Long Dim lc As Long Dim c As Long Set ws = Sheets("بيانات الطلبة") c = ws.Range("C2").Value If TextBox1.Text = ws.Range("F1") Then Me.Hide TextBox1.Text = "" MsgBox "كلمة المرور صحيحة و سيتم تنفيذ المطلوب", 64 Application.ScreenUpdating = False Application.Calculation = xlManual 'اذا كان عدد المتقدمين اقل من اتنين يتم ايقاف الكود ولا يكمل If ws.Range("C2") < 2 Then Exit Sub End If For Each sh In Sheets(Array("بيانات الطلبة", "إنجاز1", "تحريرى ف 1", "تحريرى ف 2", "أعمال السنة", "كشف الدور الثاني", "رصد الترم الثانى", "كشف ناجح")) lr = IIf(LastOccupiedRowNum(sh) = 7, 7, LastOccupiedRowNum(sh)) lc = LastOccupiedColNum(sh) 'حذف البيانات الموجودة في النطاق المحدد sh.Range("A8").Resize(Rows.Count - 7, lc).Clear 'نسخ الصف السابع لكل شيت من حيث عدد الاعمدة الى العدد المحدد بعدد المتقدمين sh.Range("A7").Resize(1, lc).AutoFill Destination:=sh.Range("A7").Resize(c, lc) Next sh Application.Goto ws.Range("A1") Application.Calculation = xlAutomatic Application.ScreenUpdating = True Unload Me Else MsgBox "عفواً كلمة المرور خاطئه و لن يتم تنفيذ المطلوب", vbExclamation TextBox1.Text = "" TextBox1.SetFocus End If End Sub Public Function LastOccupiedRowNum(Sheet As Worksheet) As Long Dim lng As Long If Application.WorksheetFunction.CountA(Sheet.Cells) <> 0 Then With Sheet lng = .Cells.Find(What:="*", After:=.Range("A1"), Lookat:=xlPart, LookIn:=xlFormulas, SearchOrder:=xlByRows, SearchDirection:=xlPrevious, MatchCase:=False).Row End With Else lng = 1 End If LastOccupiedRowNum = lng End Function Public Function LastOccupiedColNum(Sheet As Worksheet) As Long Dim lng As Long If Application.WorksheetFunction.CountA(Sheet.Cells) <> 0 Then With Sheet lng = .Cells.Find(What:="*", After:=.Range("A1"), Lookat:=xlPart, LookIn:=xlFormulas, SearchOrder:=xlByColumns, SearchDirection:=xlPrevious, MatchCase:=False).Column End With Else lng = 1 End If LastOccupiedColNum = lng End Function '================================== Private Sub UserForm_Click() End Sub نريد شرح لهم من فضلكم
  10. جزاك الله خيرا .. جاري تضييط الملف النهائي ليكون مرجعا لمن اراده
  11. اضافه صف تحت الصفوف في صفحات

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

    المرفق تجـــــــــــــــــــــــــــــــــــــــربه - نسخة.rar
  14. السلام عليكم ورحمة الله وبركاته احبابنا في الله في هذا الكود الرائع لصاحبه الاستاذ ياسر العربي يمسح ثم ينسخ نريد ان نلغي عمليه المسح ليتم النسخ بعد الصفوف الموجوده فعلا لماذا ؟ لاننا في بعض الاحوال ياتي الى المدرسه طالب محول او اتنين فمطلوب اضافتهم تحت الصفوف في جميع الصفحات التي يعمل بها الكود السابق جزى الله الذين يبتغون وجه الله بكل خير وبارك فيهم يارب ============== ان شاء الله سارفق الكود والملف
  15. نريد من احد عمالقه الاكواد شرح الكود او بعض اسطره كرما منه
×