استدعاء العلامات حسب التقويم

[محمد عدنان]

السلام عليكم و رحمة الله و بركاته 

ارجو المساعدة بماكرو يقوم باستدعاء علامات الطالب حسب التقويم  و حسب الفصل الدراسي الاول او الثاني من صفجة MARk all  الى صفحة moncer  يتم الاختيار الطالب من combox في صفحة moncer

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

Test10.xlsm

[محمد هشام.]

هل من الممكن تزويدنا بالنتيجة المتوقعة للطالب مجمد على ورقة Moncer

[محمد عدنان]

السلام عليكم 

استاذ @محمد هشام. عند اختيار الاسم محمد  و اختيار القويم الاول من الفصل الدراسي الاول يقوم بجلب بيانات الاعمدة في التقويم الاول من السطر رقم ثمانية و جميع الاعمدة عند التقويم الاول

[محمد هشام.]

أعتذر على التأخير في الرد بسبب ظروف العمل 

على العموم تفضل أخي تم إنجاز  المطلوب بالمعادلات لصعوبة التعامل مع كثرة الخلايا المدمجة داخل الأكواد  مع بعض التعديلات البسيطة للحصول على النتائج بشكل أدق. 

 

 

 

Test11.xlsm

تم تعديل نوفمبر 25, 2023 بواسطه محمد هشام.

[محمد عدنان]

السلام عليكم 

بارك الله بجهدك استاذنا الحبيب @محمد هشام.  هل بالامكان عمل زر شهادة لجميع الطلاب ؟

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

[محمد هشام.]

Sub Print_certificates()

Dim wb As Workbook, wsData As Worksheet, wsDest As Worksheet

Set wb = ThisWorkbook: Set wsData = wb.Sheets("Mark All"): Set wsDest = wb.Sheets("Moncer")

Application.ScreenUpdating = False

On Error Resume Next
With ActiveWorkbook
        fPath = .path & Application.PathSeparator & "شهادات الطلاب" & Application.PathSeparator
        If Len(Dir(fPath, vbDirectory)) = 0 Then
        End If
        MkDir fPath
        
For List = 9 To wsData.Cells(Rows.Count, "B").End(xlUp).Row
        F = wsData.Cells(List, "B")
        wsDest.[B8] = F: wsDest.[T1] = F
wsDest.ExportAsFixedFormat Type:=xlTypePDF, Filename:=fPath & F & ".pdf"

 'wsDest.PrintOut

      Next List
    On Error GoTo 0
 End With
End Sub

 

Test12.xlsm

[محمد عدنان]

السلام عليكم 

اخ @محمد هشام. بارك الله بجهدك عند طباعة الشهادة لجميع الطلاب لا تتغير العلامات حسب الطالب المختار  

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

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

تم تعديل نوفمبر 26, 2023 بواسطه محمد عدنان

[محمد هشام.]

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

 'wsDest.PrintOut

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

تم تعديل نوفمبر 26, 2023 بواسطه محمد هشام.

[محمد عدنان]

السلام عليكم 

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

 

[محمد هشام.]

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

في حالة الرغبة في استخراج ملف Pdf واحد لجميع الطلاب ماهو إسم الملف المقترح؟ وهل هناك مانع لاظافة ورقة أخرى على الملف ام لا؟

كما يفضل أخي الكريم بما أنك توصلت لحل المشكلة الرئيسة. إغلاق الموضوع ومحاولة فتح موضوع آخر بطلبك الجديد تفاديا للخلط  .ربما يستطيع أحد الإخوة الأساتذة مساعدتك

تم تعديل نوفمبر 26, 2023 بواسطه محمد هشام.

[محمد عدنان]

اح @محمد هشام. الكود يعمل بشكل جيد بعاذر منك الخطأ مني 

بالنسبة لاسم الملف ليكون الاسم في الخلية J1 من الصفحة moncer

شكرا جزيلا لك 

تم تعديل نوفمبر 26, 2023 بواسطه محمد عدنان

[محمد هشام.]

Sub Print_certificates()

Dim wb As Workbook, wsData As Worksheet, wsDest As Worksheet
Dim fRow, fName As String, MyRng As Range, FndRng As Range
Dim Cpt As Range, Linge As String, myValue As String, Question  As Integer

Set wb = ThisWorkbook: Set wsData = wb.Sheets("Mark All"): Set wsDest = wb.Sheets("Moncer")
Set MyRng = wsDest.[A3:I46]

myValue = "توقيع ولي الأمر:"

Question = MsgBox("طباعة شهادات جميع الطلاب ؟", vbYesNo + vbInformation + vbDefaultButton2, "...تأكيد")
    If Question = vbYes Then

If Len(wsDest.[J1].Value) = 0 Then: MsgBox "المرجوا إدخال إسم الملف", vbOKOnly + vbCritical + vbDefaultButton1 + vbApplicationModal, "إنتباه": Exit Sub


Application.ScreenUpdating = False
Application.DisplayAlerts = False

With model
.Visible = xlSheetVisible: .Cells.Clear: .ResetAllPageBreaks
End With

On Error Resume Next
With ActiveWorkbook
fFolder = .path & Application.PathSeparator & "شهادات الطلاب" & Application.PathSeparator
    If Len(Dir(fFolder, vbDirectory)) = 0 Then
End If
MkDir fFolder
On Error GoTo 0

For cList = 9 To wsData.Cells(Rows.Count, "B").End(xlUp).Row
cName = wsData.Cells(cList, "B"): wsDest.[B8] = cName
 wsDest.[T1] = cName: fName = wsDest.[J1]
MyRng.Copy

With model.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
    .PasteSpecial xlPasteValues: .PasteSpecial xlPasteFormats: .PasteSpecial xlPasteColumnWidths
         Application.CutCopyMode = False
     End With
  Next cList
 End With
 
With model
fRow = .Range("A:A").Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
Set FndRng = .Range("A17:A" & fRow)

Set Cpt = FndRng.Find(What:=myValue, LookIn:=xlFormulas, _
                       LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext)

If Not Cpt Is Nothing Then: Linge = Cpt.Address
Do
If Not Cpt Is Nothing Then: Cpt.RowHeight = 21: Cpt.Offset(2).PageBreak = xlPageBreakManual: Cpt.Offset(-1).RowHeight = 36
 Set Cpt = FndRng.FindNext(Cpt)
   If Cpt Is Nothing Then: Exit Do
     If Cpt.Address = Linge Then: Exit Do

   Loop
    
    model.ExportAsFixedFormat Type:=xlTypePDF, Filename:=fFolder & fName & ".pdf"
  'قم بتفعيل هداالسطر في حالة الرغبة بطباعة الشواهد
  ' .PrintOut
    .Visible = xlSheetVeryHidden
End With
    
 Application.ScreenUpdating = True
 Application.DisplayAlerts = True

MsgBox fFolder & "" & fName, vbOKOnly + vbInformation + vbDefaultButton1 + vbApplicationModal, " :تم حفظ شهادات الطلاب بنجاج في"
End If
End Sub

 

Test13.xlsm

تم تعديل نوفمبر 27, 2023 بواسطه محمد هشام.

[محمد عدنان]

الاستاذ @محمد هشام. بارك الله بجهدك و علمك ما شاء الله عليك و على سعة صدرك  جزاك الله الجنة 

[محمد هشام.]

العفو اخي يسعدني انني  استطعت مساعدتك 

بالتوفيق.

[محمد عدنان]

اخ @محمد هشام. اعتذر منك  هل بالامكان اضافة بيانات الاسم من الاعمدة  FZ,GA,GB,GZ  الى الخلية تحت الاسم 

اعتذر منك انسيتهم 

[حسونة حسين]

قواعد المشاركة فى الموقع اضغط هنـــــــــامن فضلك لقراءة القواعد كاملة
و بصفة خاصة نؤكدعلى ما يلي
1- يمنع منعا باتا نشر أية مواد تخالف حقوق الملكية الفكرية و يرجى الابلاغ عن المشاركات المخالفة من خلال زر تقرير اسفل المشاركة
2-يجب استخدام خاصيةالبحث قبل طرح السؤال توفيرا للوقت و الجهد.
3-ضرورة كتابة عنوان واضح للموضوع يدل على محتواه ويعطي وصفاً مختصرا للسؤال.
4-ممنوع منعا باتاً كتابة عناوين سينمائية مثل عاجل ، نداء الي فلان ، الي الخبراء ، طلب مساعدة ، أريد حلا.....
5-يمكن استعجال الرد باستخدام تعبير -للرفع- و غير مسموح بالالحاح او اللوم فجميع الاعضاء يشاركون تطوعا طبقا لسعة وقتهم.
ومخالفة ذلك تعرض الموضوع للحذف

 

هذا الموضوع مخالف لقوانين المنتدي

××××××××

يمنع منعا باتا ذكر أكثر من سؤال في نفس الموضوع
××××××××
يغلق
××××××××