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

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

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

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

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

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

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

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

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

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

اضغط على F11

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

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

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

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

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

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

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

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

=====

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

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

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

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

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

==========

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

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

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

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

=========

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

يكفي جملة

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

****

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

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

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

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

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

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

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

ففي الخليه R7

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

يكفي جملة

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

شهادتين في صفحه ... رائعه النابغه.rar

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

رابط اخر

http://gulfup.co/max5s2kmcikt

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

رابط شرح بالفيديو من النابغه ساجده العزاوي من العراق اعز الله العراق واذل اعداءه

قناة ساجدة العزاوي التعليمية print excel vba طباعة شهادات الطلاب sajida alazzawi

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

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

ساهم في نشر قناتنا على مواقع التواصل الاجتماعي بدون التجاوز على خصوصيات الاخرين

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

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

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

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

Sub ثلاثة_معايير()
'   هذا الكود للنابغه ساجده العزاوي
' وهي من أهلنا بالعراق أعز الله العراق وأذل أعداءه
'تم في اكتوبر 2017
'كمعطيات المحترم ابو أحمد محمدي
'الهدف من الكود هو استخراج الشهادات
'كل شهادتين في صفحه واحدة
'بثلاث معايير
'=*=*=*=*=*
 Dim SHEHADA As Worksheet, DATA As Worksheet
 Dim myArray, targt, targt2, targt3 As String
 
    'اسم صفحة المصدر
    Set DATA = Worksheets("رصد الترم الثانى")
    
     'اسم صفحة الهدف
    Set SHEHADA = Worksheets("شهاده 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("M3") = "" Or Range("M19") = "" Or SHEHADA.Range("M19") = "") Then GoTo 1
    If i < lr And c = 2 Then SHEHADA.Range("a1:p31").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 بمعيارين()
'   هذا الكود للنابغه ساجده شهاده ب1معيار العزاوي
' وهي من أهلنا بالعراق أعز الله العراق وأذل أعداءه
'تم في اكتوبر 2017
'كمعطيات المحترم ابو أحمد محمدي
'الهدف من الكود هو استخراج الشهادات
'كل شهادتين في صفحه واحدة
'بمعيارين
'=*=*=*=*=*
 Dim SHEHADA As Worksheet, DATA As Worksheet
     Dim myArray, targt, targt2 As String
     
    'اسم صفحة المصدر
    Set DATA = Worksheets("رصد الترم الثانى")    'اسم شيت قاعدة البيانات
    
        'اسم صفحة الهدف
    Set SHEHADA = Worksheets("شهاده 2معيار")    'اسم الشيت الخاص بالشهادات
    ' 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("M3") = "" Or Range("M19") = "" Or SHEHADA.Range("M19") = "") Then GoTo 1
    If i < lr And c = 2 Then SHEHADA.Range("a1:p31").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
'كمعطيات المحترم ابو أحمد محمدي
'الهدف من الكود هو استخراج الشهادات
'كل شهادتين في صفحه واحدة
'بمعيار
'=*=*=*=*=*
 Dim SHEHADA As Worksheet, DATA As Worksheet
     Dim myArray, targt, targt2 As String
     
    'اسم صفحة المصدر
    Set DATA = Worksheets("رصد الترم الثانى")    'اسم شيت قاعدة البيانات
    
        'اسم صفحة الهدف
    Set SHEHADA = Worksheets("شهاده ب1معيار")    'اسم الشيت الخاص بالشهادات
    ' 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 c = 0 Then
     Range("M3") = DATA.Cells(i, 2)
            c = c + 1
            '===
            
   ElseIf DATA.Cells(i, 101) Like targt & "*" 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
   ElseIf DATA.Cells(i, 101) Like targt & "*" 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("M3") = "" Or Range("M19") = "" Or SHEHADA.Range("M19") = "") Then GoTo 1
    If i < lr And c = 2 Then SHEHADA.Range("a1:p31").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

=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

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

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

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

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

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

تسجيل الدخول

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

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

ناصر سعيد

ناصر سعيد

ناصر سعيد

ناصر سعيد

ناصر سعيد

ناصر سعيد

ناصر سعيد

ناصر سعيد

Join the conversation

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

تصفح الموقع

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

Support

Important Information