عمل الشهادات المدرسيه 2

**ناصر سعيد** · أكتوبر 23, 2017

بسم الله الرحمن الرحيم

احبابنا في الله

ادعو الله ان تكونوا بخير يارب

هذا ملف به كود خاص باخراج شهادات الطلاب كل 3 شهادات في صفحه وما أسهله

الكود للنابغه ساجده العزاوي

طريقه الاستفاده من هذا الملف

افتح هذا الملف

اضغط على زر ALT وانت ماتزال ضاغط

اضغط على F11

سيتم فتح محرر الاكواد .. ستجد امامك موديولات بها الاكواد

دبل كليك على اول موديول

ثم اضغط من لوحة المفاتيح على ALT +SHEFT

لتكون اللغه هي العربيه

منعا لظهور اللغه العربيه بشكل طلاسم

اجعل مؤشر الماوس في الكود ثم اضغط CTRL +A

لتحديد الكود كله

ثم CTRL+C ليتم النسخ

=====

** افتح ملفك وافتح محرر الاكواد كما اشرنا سابقا

** ومن قائمه محرر الاكواد التي فتحت امامك

** اختر Insert واختر منها Module

** ثم ضع المؤشر في Module

** والصق الكود

==========

ماهي التغييرات التي تحدثها في الكود حتى يكون صالحا للاستعمال ؟

** غير اسم صفحه مصدر البيانات

** غير اسم صفحة الشهادات

** غير رقم عمود المعيار

=========

احمد الله وادعو لكل من له بصمه في اخراج هذا العمل بالخير

يكفي جملة

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

****

في صفحه الشهادات يوجد خليه R7 و S7 و T7

في حاله شهادات المعيار الواحد

نستطيع ان ننستدعي شهادات الناجحين كلهم

او اللي عندهم دور تان كلهم

بمجرد كتابه ( نا ) اختصار كلمه ناجح او (دور ) اختصار كلمه دور تان

**************

اما الشهادات ذات المعيارين

ففي الخليه R7

نكتب كلمه (نا ) اختصار كلمه ناجح او ( دور ) اختصار كلمه دور تان

وفي الخليه S7 نكتب ( ول) اختصار كلمه ولد او نكتب (بن) اختصار كلمه بنت

وهكذا نكون استطعنا ان نستدعي

شهادات الاولاد الناجحين

او الاولاد اللي عندهم دور تان

او البنات الناجحين او البنات اللي عندهم دور تان

**************

اما الشهادات ذات الثلاثه معايير

ففي الخليه R7 نكتب كلمه (نا ) او ( دور )

وفي الخليه S7 نكتب ( ول ) اختصار كلمه ولد

او نكتب ( بن ) اختصار كلمه بنت

وفي الخليه T7 نكتب الفصل (3/1 ) مثلا

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

او البنات الناجحين في فصل معين

او البنات اللي عندهم دور تان في فصل معين

**************

يكفي جملة

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

https://up.top4top.net/downloadf-661r3nat1-rar.html

===

رابط اخر

http://gulfup.co/gpl28i1u5gzs

للعلم هذا الموضوع خاص باستخراج 4 شهادات في صفحه واحده بمعايير مختلفه
وليس 3 شهادات مثل الموضوع السابق

موضوع خاص باستخراج 3 شهادات في صفحه واحده بمعايير مختلفه

**ناصر سعيد** · أكتوبر 23, 2017

جزاكم الله كل خير وبارك الله في النافع

تم تعديل أكتوبر 23, 2017 بواسطه ناصر سعيد

**ناصر سعيد** · أكتوبر 25, 2017

**ناصر سعيد** · أكتوبر 25, 2017

*************************

طباعة شهادات الناجحين والراسبين ج3 طباعة 4 شهادات بورقة طباعة 3 شهادات print excel vba ساجدة العزاوي طلاب طلبة مدارس مدرسة شهادات الطلاب استخراج شهادات الطلبة طباعة شهادات الطلاب طباعة تقدير الطلاب نتائج نتيجة قناة ساجدة العزاوي التعليمية sajida alazzawi رابط ملف التطبيق 4 شهادات http://www.mediafire.com/file/yr1rrb7...

رابط ملف 3 شهادات http://www.mediafire.com/file/p2k2u8x...

رابط صفحة الفيس بوك https://www.facebook.com/sajidaalazza...

**ناصر سعيد** · أكتوبر 26, 2017

رابط عمل شهادتين كل صفحه

**ناصر سعيد** · أكتوبر 28, 2017

Sub ثلاثة_معايير()
'   هذا الكود للنابغه ساجده العزاوي
' وهي من أهلنا بالعراق أعز الله العراق وأذل أعداءه
'تم في اكتوبر 2017
'كمعطيات المحترم ابو أحمد محمدي
'الهدف من الكود هو استخراج الشهادات
'كل 4 شهادات في صفحه واحدة
'بثلاث معايير
'=*=*=*=*=*
 Dim SHEHADA As Worksheet, DATA As Worksheet
 Dim myArray, targt, targt2, targt3 As String
 
    'اسم صفحة المصدر
    Set DATA = Worksheets("رصد الترم الثانى")
    
     'اسم صفحة الهدف
    Set SHEHADA = Worksheets("4 شهادات ب3 معايير")
'===================
    'targt = "ناج*"
   ' targt2 = "ول*"
   ' targt3 = "5/1"
     targt = SHEHADA.Range("R7").Value & "*"
    targt2 = SHEHADA.Range("S7").Value & "*"
    targt3 = SHEHADA.Range("T7").Value & "*"
'===================
c = 0
Application.ScreenUpdating = False
    lr = DATA.Cells(Rows.Count, 2).End(xlUp).Row   'اخر صف به بيانات

' عدد الصفوف الخارجة
'عن التوزيع في ورقة مصدر البيانات
  'هذا السطر في حال شهادات الكل
       For i = 7 To lr
       
       'هذا السطر في حال طلب شهادات محدده
     '   For i = sh4.Cells(7, 18).Value To sh4.Cells(7, 19).Value

    '=======
If DATA.Cells(i, 101) Like targt & "*" And DATA.Cells(i, 104) Like targt2 & "*" And DATA.Cells(i, 103) Like targt3 & "*" And c = 0 Then
     Range("M3") = DATA.Cells(i, 2)
            c = c + 1
            '===
            
   ElseIf DATA.Cells(i, 101) Like targt & "*" And DATA.Cells(i, 104) Like targt2 & "*" And DATA.Cells(i, 103) Like targt3 & "*" And c = 1 Then
     Range("M19") = DATA.Cells(i, 2)
            c = c + 1
            '===
            
   ElseIf DATA.Cells(i, 101) Like targt & "*" And DATA.Cells(i, 104) Like targt2 & "*" And DATA.Cells(i, 103) Like targt3 & "*" And c = 2 Then
     Range("M35") = DATA.Cells(i, 2)
            c = c + 1
            '===

   ElseIf DATA.Cells(i, 101) Like targt & "*" And DATA.Cells(i, 104) Like targt2 & "*" And DATA.Cells(i, 103) Like targt3 & "*" And c = 3 Then
     SHEHADA.Range("M48") = DATA.Cells(i, 2)
            c = c + 1
            '===
    
            End If
    If i = lr And c = 4 Then SHEHADA.Range("a1:P59").PrintOut: Exit For
    If i = lr And c = 3 Then SHEHADA.Range("a1:p45").PrintOut: Exit For
    If i = lr And c = 2 Then SHEHADA.Range("a1:p30").PrintOut: Exit For
    If i = lr And c = 1 Then SHEHADA.Range("a1:p15").PrintOut: Exit For
    If i < lr And (SHEHADA.Range("M18") = "" Or SHEHADA.Range("M48") = "") Then GoTo 1
    If i < lr And c = 4 Then SHEHADA.Range("a1:P59").PrintOut
      c = 0
     Range("M3") = ""
     Range("M18") = ""
     Range("M33") = ""
     Range("M48") = ""
1:
   Next i
     Range("M3") = ""
     Range("M18") = ""
     Range("M33") = ""
     Range("M48") = ""
   Application.ScreenUpdating = True
End Sub

جزى الله كل من كانت له بصمه في هذا الكود بالخير

Sub بمعيارين()
'   هذا الكود للنابغه ساجده العزاوي
' وهي من أهلنا بالعراق أعز الله العراق وأذل أعداءه
'تم في اكتوبر 2017
'كمعطيات المحترم ابو أحمد محمدي
'الهدف من الكود هو استخراج الشهادات
'كل 4 شهادات في صفحه واحدة
'بمعيارين
'=*=*=*=*=*
 Dim SHEHADA As Worksheet, DATA As Worksheet
     Dim myArray, targt, targt2 As String
     
    'اسم صفحة المصدر
    Set DATA = Worksheets("رصد الترم الثانى")    'اسم شيت قاعدة البيانات
    
        'اسم صفحة الهدف
    Set SHEHADA = Worksheets("4 شهادات بمعيارين")    'اسم الشيت الخاص بالشهادات
    ' targt = "ناج*"
     'targt2 = "ول*"
     targt = SHEHADA.Range("R7").Value & "*"
     targt2 = SHEHADA.Range("S7").Value & "*"
'===================
c = 0
Application.ScreenUpdating = False
    lr = DATA.Cells(Rows.Count, 2).End(xlUp).Row   'اخر صف به بيانات

' عدد الصفوف الخارجة عن التوزيع في ورقة مصدر البيانات
  'هذا السطر في حال شهادات الكل
       For i = 7 To lr
       
       'هذا السطر في حال طلب شهادات محدده
     '   For i = sh4.Cells(7, 18).Value To sh4.Cells(7, 19).Value

    '=======
If DATA.Cells(i, 101) Like targt & "*" And DATA.Cells(i, 104) Like targt2 & "*" And c = 0 Then
     Range("M3") = DATA.Cells(i, 2)
            c = c + 1
            '===
            
   ElseIf DATA.Cells(i, 101) Like targt & "*" And DATA.Cells(i, 104) Like targt2 & "*" And c = 1 Then
     Range("M19") = DATA.Cells(i, 2)
            c = c + 1
              '===
              
   ElseIf DATA.Cells(i, 101) Like targt & "*" And DATA.Cells(i, 104) Like targt2 & "*" And c = 2 Then
     Range("M35") = DATA.Cells(i, 2)
            c = c + 1
              '===
              
  ' ElseIf DATA.Cells(i, 101) Like targt & "*" And DATA.Cells(i, 104) Like targt2 & "*" And c = 3 Then
    ' SHEHADA.Range("M51") = DATA.Cells(i, 2)
          '  c = c + 1
               '===
               

            End If
            
   ' If i = lr And c = 4 Then SHEHADA.Range("a1:p63").PrintOut: Exit For
    If i = lr And c = 3 Then SHEHADA.Range("a1:p47").PrintOut: Exit For
    If i = lr And c = 2 Then SHEHADA.Range("a1:p31").PrintOut: Exit For
    If i = lr And c = 1 Then SHEHADA.Range("a1:p15").PrintOut: Exit For
    If i < lr And (Range("M19") = "" Or Range("M35") = "" Or SHEHADA.Range("M51") = "") Then GoTo 1
    If i < lr And c = 3 Then SHEHADA.Range("a1:p47").PrintOut
      c = 0
     Range("M3") = ""
     Range("M19") = ""
     Range("M35") = ""
    ' Range("M51") = ""
1:
   Next i
     Range("M3") = ""
     Range("M19") = ""
     Range("M35") = ""
    ' Range("M51") = ""
   Application.ScreenUpdating = True
End Sub

**ناصر سعيد** · أكتوبر 28, 2017

'******************

'   هذا الكود للنابغه ساجده العزاوي
' وهي من أهلنا بالعراق أعز الله العراق وأذل أعداءه
'تم في اكتوبر 2017
'كمعطيات المحترم ابو أحمد محمدي
'الهدف من الكود هو استخراج الشهادات
' بمعيار واحد كل 4 شهادات في صفحه واحدة
'=*=*=*=*=*
Sub اربع_شهادات()
Application.ScreenUpdating = False
    Dim DATA As Worksheet
    Dim SHEHADA As Worksheet
    Dim myArray, targt

    'اسم صفحة المصدر
    Set DATA = ThisWorkbook.Worksheets("رصد الترم الثانى")
    
        'اسم صفحة الشهادة
    Set SHEHADA = ThisWorkbook.Worksheets("4شهادات")
        
        'معيار البحث
        'targt = "ناج*"
     targt = SHEHADA.Range("R7").Value & "*"
'*********************************
    c = 0
    
lr = DATA.Range("b1000").End(xlUp).Row

'رقم اول صف في صفحة المصدر
    For i = 7 To lr
    
    'رقم عمود المعيار في صفحة المصدر
         If DATA.Cells(i, 101) Like targt & "*" And c = 0 Then
            SHEHADA.Range("M3") = DATA.Cells(i, 2)
            c = c + 1
            
             'رقم عمود المعيار في صفحة المصدر
                 ElseIf DATA.Cells(i, 101) Like targt & "*" And c = 1 Then
            SHEHADA.Range("M18") = DATA.Cells(i, 2)
            c = c + 1
            
                'رقم عمود المعيار في صفحة المصدر
             ElseIf DATA.Cells(i, 101) Like targt & "*" And c = 2 Then
            SHEHADA.Range("M33") = DATA.Cells(i, 2)
            c = c + 1
            
             ElseIf DATA.Cells(i, 101) Like targt & "*" And c = 3 Then
     SHEHADA.Range("M48") = DATA.Cells(i, 2)
           c = c + 1
            '===

            End If
    If i = lr And c = 4 Then SHEHADA.Range("a1:P59").PrintOut: Exit For
    If i = lr And c = 3 Then SHEHADA.Range("a1:p45").PrintOut: Exit For
    If i = lr And c = 2 Then SHEHADA.Range("a1:p30").PrintOut: Exit For
    If i = lr And c = 1 Then SHEHADA.Range("a1:p15").PrintOut: Exit For
    If i < lr And (SHEHADA.Range("M18") = "" Or SHEHADA.Range("M48") = "") Then GoTo 1
    If i < lr And c = 4 Then SHEHADA.Range("a1:P59").PrintOut
      c = 0
      
     Range("M3") = ""
     Range("M18") = ""
     Range("M33") = ""
     Range("M48") = ""
1:
   Next i
     Range("M3") = ""
     Range("M18") = ""
     Range("M33") = ""
     Range("M48") = ""

   Application.ScreenUpdating = True
End Sub

**ناصر سعيد** · أكتوبر 28, 2017

=IFERROR(INDEX('شيت  الرابع الرئيسى'!$A$9:$FH$1000;MATCH($I$5;'شيت  الرابع الرئيسى'!$C$9:$C$1000);2);"")

المعادله التي تستخدم في الشهاده

من الروائع

**ناصر سعيد** · نوفمبر 3, 2017

**ناصر سعيد** · نوفمبر 12, 2017

Sub SortData()

    Dim lr As Long

    lr = Range("E" & Rows.Count).End(xlUp).Row

    For Each Cell In ActiveSheet.Range("E7:E" & lr)

        Cell.Value = Application.WorksheetFunction.Trim(Cell.Value)

    Next

    Range("B7:S" & lr).Sort Key1:=Range("F7:F" & lr), Order1:=2, Key2:=Range("E7:E" & lr), Order2:=1, Header:=xlNo

End Sub

كود للفرز بمعيارين

ولكن به اضافه مفيده

وهي ازاله المسافات من بين الاسماء

مما تعطي فرزا دقيقا

للمحترم الغالي ياسر العربي

تسجيل الدخول

عمل الشهادات المدرسيه 2

الردود الموصى بها

ناصر سعيد

ناصر سعيد

ناصر سعيد

ناصر سعيد

ناصر سعيد

ناصر سعيد

ناصر سعيد

ناصر سعيد

ناصر سعيد

ناصر سعيد

Join the conversation

تصفح هذا الموضوع مؤخراً 0 اعضاء متواجدين الان

تصفح الموقع

تصفح جديد الموقع

Support

Important Information