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

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

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

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

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

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

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

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

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

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

اضغط على F11

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

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

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

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

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

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

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

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

=====

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

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

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

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

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

==========

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

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

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

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

=========

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

يكفي جملة

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

https://up.top4top.net/downloadf-660wkhd91-rar.html

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

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

Sub ثلاثة_معايير()
'   هذا الكود للنابغه ساجده العزاوي
' وهي من أهلنا بالعراق أعز الله العراق وأذل أعداءه
'تم في اكتوبر 2017
'كمعطيات المحترم ابو أحمد محمدي
'الهدف من الكود هو استخراج الشهادات
'كل 3 شهادات في صفحه واحدة
'بثلاث معايير
'=*=*=*=*=*
 Dim SHEHADA As Worksheet, DATA As Worksheet
 Dim myArray, targt, targt2, targt3 As String
 
    'اسم صفحة المصدر
    Set DATA = Worksheets("رصد الترم الثانى")
    
     'اسم صفحة الهدف
    Set SHEHADA = Worksheets("3 شهادات ب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("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

هذا احد الاكواد الموجوده .. سهوله ودقه ويسر .. يسرها الله على الجميع

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

نرجو من احد المشرفين المحترمين ان يضع الملف على المنتدى حتى لايضيع

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

رابط اخر لنفس الملف

https://www.gulf-up.com/downloadf-1508711740761-rar.html

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

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

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

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

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

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

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

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

ففي الخليه R7

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

يكفي جملة

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

================

نفس الملف على رابط هديه من المحترم ياسر خليل

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

http://www.mediafire.com/file/gijv96lp85d5661/شهادات+الطلاب+1.rar

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

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

**ناصر سعيد** · أكتوبر 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
'كمعطيات المحترم ابو أحمد محمدي
'الهدف من الكود هو استخراج الشهادات
'كل 3 شهادات في صفحه واحدة
'بثلاث معايير
'=*=*=*=*=*
 Dim SHEHADA As Worksheet, DATA As Worksheet
 Dim myArray, targt, targt2, targt3 As String
 
    'اسم صفحة المصدر
    Set DATA = Worksheets("رصد الترم الثانى")
    
     'اسم صفحة الهدف
    Set SHEHADA = Worksheets("3 شهادات ب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("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

Sub بمعيارين()
'   هذا الكود للنابغه ساجده العزاوي
' وهي من أهلنا بالعراق أعز الله العراق وأذل أعداءه
'تم في اكتوبر 2017
'كمعطيات المحترم ابو أحمد محمدي
'الهدف من الكود هو استخراج الشهادات
'كل 3 شهادات في صفحه واحدة
'بمعيارين
'=*=*=*=*=*
 Dim SHEHADA As Worksheet, DATA As Worksheet
     Dim myArray, targt, targt2 As String
     
    'اسم صفحة المصدر
    Set DATA = Worksheets("رصد الترم الثانى")    'اسم شيت قاعدة البيانات
    
        'اسم صفحة الهدف
    Set SHEHADA = Worksheets("3 شهادات بمعيارين")    'اسم الشيت الخاص بالشهادات
    ' 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
'كمعطيات المحترم ابو أحمد محمدي
'الهدف من الكود هو استخراج الشهادات
' بمعيار واحد كل 3 شهادات في صفحه واحدة
'=*=*=*=*=*
Sub تلات_شهادات()
Application.ScreenUpdating = False
    Dim DATA As Worksheet
    Dim SHEHADA As Worksheet
    Dim myArray, targt

    'اسم صفحة المصدر
    Set DATA = ThisWorkbook.Worksheets("رصد الترم الثانى")
    
        'اسم صفحة الشهادة
    Set SHEHADA = ThisWorkbook.Worksheets("3شهادات")
        
        'معيار البحث
        '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("M19") = DATA.Cells(i, 2)
            c = c + 1
            
                'رقم عمود المعيار في صفحة المصدر
             ElseIf DATA.Cells(i, 101) Like targt & "*" And c = 2 Then
            SHEHADA.Range("M35") = DATA.Cells(i, 2)
            c = c + 1
            End If
            
    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 (SHEHADA.Range("M19") = "" Or SHEHADA.Range("M35") = "") Then GoTo 1
    If i < lr And c = 3 Then SHEHADA.Range("a1:p47").PrintOut
      c = 0
      
     Range("M3") = ""
     Range("M19") = ""
     Range("M35") = ""
    
    
1:
   Next i
     Range("M3") = ""
     Range("M19") = ""
     Range("M35") = ""
    
   Application.ScreenUpdating = True
End Sub

=============

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

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

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

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

من الروائع

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

روابط شرح الفيديو

ملف التطبيق
http://www.mediafire.com/file/yr1rrb7...

==============================
http://gulfup.co/itpyj0db0zzp

================================
رابط اخر

https://up.top4top.net/downloadf-644qz4ck1-rar.html

**ناصر سعيد** · نوفمبر 2, 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

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

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

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

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

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

تسجيل الدخول

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

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

رابط هذا التعليق

شارك

رابط هذا التعليق

شارك

رابط هذا التعليق

شارك

رابط هذا التعليق

شارك

رابط هذا التعليق

شارك

رابط هذا التعليق

شارك

رابط هذا التعليق

شارك

رابط هذا التعليق

شارك

رابط هذا التعليق

شارك

رابط هذا التعليق

شارك

رابط هذا التعليق

شارك

رابط هذا التعليق

شارك

رابط هذا التعليق

شارك

رابط هذا التعليق

شارك

رابط هذا التعليق

شارك

Join the conversation

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

Important Information