hicham2610

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

الحمد لله تمكنت من حل المشكل بالكود الأخير
الحل هو كتابة الامتداد داخل الكود
"fichier1.xlsm"  وليس فقط  fichier1
 

السلام عليكم
حللت المشكلة 
MsgBox UserName + " مرحبا بكم في مسابقتي التفاعلية", vbApplicationModal, " هشام بازغ-مسابقة تفاعلية في السكراتش"  

السلام عليكم
توصلت بالحل التالي ، أضعه هنا للإفادة:
Sub gestnoexamen() Dim Dl As Integer Dl = Cells(Rows.Count, "D").End(xlUp).Row '' << trouve la dernière ligne Application.ScreenUpdating = False Range("T17").FormulaR1C1 = "=COUNTIF(R17C6:RC[-14],RC[-14])" Range("T17").AutoFill Destination:=Range("T17:T" & Dl) ActiveWorkbook.Worksheets("g").AutoFilter.Sort.SortFields.Clear ActiveWorkbook.Worksheets("g").AutoFilter.Sort.SortFields.Add2 Key:=Range( _ "T16"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal With ActiveWorkbook.Worksheets("g").AutoFilter.Sort .Header = xlYes .MatchCase = False .Orientation = xlTopToBottom .SortMethod = xlPinYin .Apply End With Range("B17").FormulaR1C1 = "1" Range("B18").FormulaR1C1 = "2" Range("B17:B18").AutoFill Destination:=Range("B17:B" & Dl) Range("T9").Select Application.ScreenUpdating = True MsgBox "تم توزيع المترشحين" End Sub والله ولي التوفيق

السلام عليكم
الأخ الكريم
أنت ضف السطر العلوي ثم مكان الكود هنا أكتب الكود الخاص بك ثم السطر السفلي
passe هو الرقم السري الذي وضعت لحماية الشيت.
فمهمة السطر العلوي فك الحماية (الرقم السري ) الذي وضعت ومهمة السطر الأخير إعادة الرقم السري لحماية الورقة من التعديل

الفكرة: أن الماكرو يصطدم بالباس الذي وضعته، ماذا ستفعل؟ الجواب: إعطاءه الباس لتنفيذ الماكرو بمعنى فك الحماية ثم استعادة الحماية بعد تنفيذ الماكرو.
بالتوفيق إن شاء الله

السلام عليكم
تفضل هذه المحاولة بالمعادلات ، أتمنى أن تفي بالغرض
والسلام عليكم
المجموع العام ن1.xlsm

السلام عليكم
توصلت بهذا الحل وتعميما للفائدة أتقاسمه معكم:
Option Explicit Dim tablo, tabloR() Dim i&, iR&, j& Sub SupprimerLesVides() tablo = Range("X10:AP48") ReDim tabloR(1 To UBound(tablo, 1), 1 To UBound(tablo, 2)) For j = 1 To UBound(tablo, 2) If j <> 5 And j <> 10 And j <> 15 Then iR = 1 For i = 1 To UBound(tablo, 1) If tablo(i, j) <> "" Then tabloR(iR, j) = tablo(i, j) iR = iR + 1 End If Next i End If Next j Range("X10:AP48").ClearContents Range("X10").Resize(UBound(tabloR, 1), UBound(tabloR, 2)) = tabloR End Sub  

السلام عليكم
أو 
أن سبب المشكلة أوفيس 2007 فهو غالبا لاتكون فيه PDF
لأداة التي نضيفها ل2007 ليصبح يدعم PDF
https://soft.telecharger.com/office/SaveAsPDFandXPS.exe

السلام عليكم
ضروري من إرفاق ملف تشرح فيه المطلوب
إليك هذه المحاولة،حسب فهمي لطلبك ،أتمنى أن تفي بالغرض:
والسلام عليكم
غير موجود بالمخزن.xlsx

وعليكم السلام
تفضل:
 
نموذح.xlsm

السلام عليكم
وهذا بصيغة أكثر تطورا
لا يتم احتساب المعدل إلا إن وضعت النقط الثلاثة بكاملها ، إن نقصت واحدة لايتم احتساب المعدل حتى توضع بكاملها
kaddour3.xlsx

السلام عليكم
تفضل تدخلي بحسب مافهمت
أتمنى أن يفي بالغرض
req.xlsx