محمد هشام.

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

يمكنك استخدام المعادلة التالية لاستخراج الفرق بالشهور =DATEDIF(H2;P2;"m") مثال 12/4/2022____27/4/2029________النتيجة هي 96 شهر وهده ادا كانت لك رغبة باستخراج النتيجة بالاعداد الكسرية =FRACTION.ANNEE(H2;P2)*12 12/4/2022____27/4/2029________ النتيجة هي 96.5 شهر ونصف Copy of Book13(2).xlsx

بعد تسمية النطاقات بخاصية (Name Manager) تم وضع معادلة البحث التالية =INDEX(Data!$C$3:$D$300;EQUIV('شهادة صف ثالث'!$K$47;Data!$C$3:$C$300;0);2) اما بالنسبة للصورة لم يتم وضع اي اطار خاص بها يمكنك تغيير مكانها كيفما شئت

1) لاحظت ان عدد الطلبة يفوق 200 طالب يستحيل انك تضيف كل صورة لوحدها 🤔🤔 اليك اخي الفاضل هدا الكود الدي سيمكنك من اضافة الصور دفعة واحدة ومرتبة (قبل تشغيل الكود تاكد من وقوفك على الخلية المراد اضافة الصورة اليها) 2) وهدا رابط شرح طريقة اضافة الصور للملف : https://streamable.com/ti3tnn Sub InsertMultiplePictures_MH() Dim Pictures() As Variant Dim PictureFormat As String Dim Rng As Range Dim PicShape As Shape On Error Resume Next Pictures = Application.GetOpenFilename(PictureFormat, MultiSelect:=True) xColIndex = Application.ActiveCell.Column If IsArray(Pictures) Then xRowIndex = Application.ActiveCell.Row For lLoop = LBound(Pictures) To UBound(Pictures) Set Rng = Cells(xRowIndex, xColIndex) Set PicShape = ActiveSheet.Shapes.AddPicture(Pictures(lLoop), msoFalse, msoCTrue, Rng.Left, Rng.Top, Rng.Width, Rng.Height) xRowIndex = xRowIndex + 1 Next End If End Sub ولازالة الصور القديمة Sub DeleteImage() Dim pic As Picture For Each pic In ActiveSheet.Pictures If Not Application.Intersect(pic.TopLeftCell, Range("D3:D300")) Is Nothing Then pic.Delete End If Next pic End Sub تم اضافة الاكواد للملف المرفق شهادات صف ثالث_M-H.rar

تفضل اخي الفاضل Book2-M-H.xlsm

تفاديا للعمل على التخمين حاول رفع نسخة للملف

Rng_1.Copy sh.Cells(Rows.Count, "A").End(xlUp).Offset(1, 0)

Option Explicit Private Sub Workbook_Open() Application.Visible = False UserForm1.Show End Sub Private Sub Workbook_BeforeClose(Cancel As Boolean) Application.Visible = True End Sub

جرب اخي المعادله التالية =IF(OR(I5="",H5="",J5=""), "",IF(J5-(I5+H5)<=25, "Pending", IF(AND(J5-(H5+I5)>=26,J5-(H5+I5)<=29),"Notify", IF(J5-(H5+I5)>=30,"Done", "")))) Test-M-H-4.xlsx

Test-M-H-3.xlsxجرب ممكن هذا ما تقصد

اخي الفاضل. هل تقصد تغيير الحالة بناءا على التاريخ الموجود في عمود D

على حسب ما فهمت من طلبك ضع هذه المعادلة في الخلية B10 =SIERREUR(SI(B10="";"";DATEDIF(B10;D10;"d"));"") و اسحبها حتى آخر صف وفي الخلية E10 =SI(C10="";"";SI(C10<=25;"Pending";SI(C10=26;"Notify";SI(C10=27;"Notify";SI(C10=28;"Notify";SI(C10=29;"Notify";SI(C10>=30;"Done"))))))) و اسحبها حتى آخر صف Test-M-H.xlsx

تفضل اخي نفذ الخطوات التالية test.xlsx او حاول ترفع الملف مرة أخرى هل الشيت به معادلات؟

الملف المرسل غير صالح !!!!!

جرب اخي تعديل.rar

taqrer.xlsm

تفضل اخي نفذ الخطوات التالية https://streamable.com/851pys

كان لازم اخي تضيف هذا الكود في حدث الشيت 😄 Private Sub Worksheet_Change(ByVal Target As Range) ActiveSheet.Unprotect If Not Intersect(Sheets("Sheet1").Range("N9"), Target) Is Nothing Then Range("N24").Value = Range("N24").Value + 1 End If ActiveSheet.Protect End Sub جرب اخي الكريم الملف المرفق اضافة رقم الطباعة.xls

tabl12-M_H.xlsm

يمكنك استخدام الاكواد التالية : Sub M_H_AverageColumns1() Application.ScreenUpdating = False Dim i As Integer Dim j As Integer Dim k As Integer Dim l As Integer j = 8 k = 9 l = 10 Do Until j > 47 For i = 11 To 55 If (Cells(i, j).Value + Cells(i, k).Value) / 2 = 0 Then Cells(i, l).Value = "" Else Cells(i, l).Value = (Cells(i, j).Value + Cells(i, k).Value) / 2 End If Next i j = j + 3 k = k + 3 l = l + 3 Loop Application.ScreenUpdating = True End Sub او هدا Sub M_H_AverageColumns2() Application.ScreenUpdating = False For i = 8 To 49 Step 3 Set u = Range(Cells(11, i + 2), Cells(55, i + 2)) u.Value = Evaluate("=(" & Range(Cells(11, i), Cells(55, i)).Address & "+ " & Range(Cells(11, i + 1), Cells(55, i + 1)).Address & ")/2") Next Application.ScreenUpdating = True End Sub ولتفريغ نفس الاعمدة بمكنك استخدام الكود التالي Sub M_H_clearColumns() Dim i As Integer Dim j As Integer Dim k As Integer Dim l As Integer Application.ScreenUpdating = False j = 8 k = 9 l = 10 Do Until j > 47 For i = 11 To 55 Cells(i, l).Value = "" Next i j = j + 3 k = k + 3 l = l + 3 Loop Application.ScreenUpdating = True End Sub تمت اضافة الاكواد للملف المرفق tabl12-M_H.xlsm

غالبا ما تظهر هذه الرسالة اخي الكريم بسبب بعض الأخطاء غير المرغوب فيها يتجمد ملف Excel وبالتالي اخي الكريم أثناء حفظ الملف تظهر رسالة خطأ مثل "Fixed Objects Will Move". اما في حالتك هذه كما ذكرت ان الرسالة تظهر اثناء عمل الفلترة فغالبا اخي الفاضل انه لديك بالملف كائنات ثابتة يمكن أن تشير "الكائنات الثابتة" إلى العديد من العناصر ، مثل التعليقات والرسومات وعناصر التحكم وما إلى ذلك. تعتبر "ثابتة" لأنها توضع في مكان على ورقة العمل ثم يحاول Excel الاحتفاظ بها في هذا المكان. إذا كنت بحاجة إلى الاحتفاظ بالعناصر ، فيمكنك محاولة التخلص من الإشعار عن طريق إخبار Excel بأنه لا بأس من تحريك الكائنات. يتضمن هذا تغيير الخصائص لكل كائن - انقر بزر الماوس الأيمن فوق الكائن واختر خصائص ، ثم حدد أو امسح خانة الاختيار التي تتحكم في إمكانية تحرك الكائن. في حالة كنت واضع حماية للشيت حاول تفعيل هذا الامر او استخدام الكود التالي Sub M_H() Application.ScreenUpdating = False On Error Resume Next With Worksheets("Sheet1") .EnableOutlining = True .EnableAutoFilter = True .Protect Password:="الرقم السري للشيت", _ Contents:=True, DrawingObjects:=False, UserInterfaceOnly:=True, _ AllowFormattingCells:=True End With Application.ScreenUpdating = True End Sub

تسديدات كل سنة M_H.xlsx

بالنسبة للسؤال الأول نعم يمكنك ذلك عبر وضع زر به كود لطباعة مدى معين وبناءا عليه يتم إظهار عدد مرات طباعة المدى في خانة من إختيارك يزيد بمقدار +1 عند كل أمر بالطباعة اليك مثال لدالك باسم منتدى اوفيسنا في الملف المرفق يمكنك فقط تعديل الكود حسب ما يناسبك. واتمنى يكون هدا هو المطلوب🤔 مثال _حساب عدد مرات الطباعة.xlsm

بالنسبة للسؤال الأول نعم يمكنك ذلك عبر وضع زر به كود لطباعة مدى معين وبناءا عليه يتم إظهار عدد مرات طباعة المدى في خانة من إختيارك يزيد بمقدار +1 عند كل أمر بالطباعة اما بالنسبة للاستفسار رقم2 يمكنك وضع هدا الكود في حدث ورقة العمل لديك Private Sub Worksheet_Change(ByVal Target As Range) If Not Intersect(Sheets("Sheet1").Range("A2"), Target) Is Nothing Then Range("B2").Value = Range("B2").Value + 1 End If End Sub (يمكنك تعديل الكود على حسب موضع الخانات لديك) لمزيد من الشرح اليك اخي الفاضل الملف يتضمن العداد مع اضافة الارقام العشوائية بواسطة القائمة المنسدلة يتبع الطلب الأول......... M-HICHAM.xlsm

فعلا لم أنتبه لوجود اليوزرفورم 🤔🤔🤔