أ / محمد صالح

يبدو أن العنصر صاحب الاسم resize غير موجود في النمودج

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

جرب المعادلة التالية في الخلية E1
=MID(A1,FIND("الاسم:",A1)+6,FIND("القسم",A1)-1-FIND("الاسم:",A1)-6) بالتوفيق 

مفيش مشكلة 
جرب هذا المعادلة
=MAX(IF(A:A=H2, D:D)) ولكن مع ضغط ctrl+shift+enter
لأنها معادلة مصفوفات

يمكنك وضع هذه المعادلة في الخلية C2
=IF(COUNTIFS(A$2:A2,A2,B$2:B2,B2)=0,"",IF(COUNTIFS(A$2:A2,A2,B$2:B2,B2)>1,MINIFS(C$1:C1,A$1:A1,A2,B$1:B1,B2),COUNT(C$1:C1)+1)) إن شاء الله تكون هي المطلوبة 

على افتراض ان الخلية التي تحتوي على الرقم هي A1
يمكنك استعمال المعادلة التالية 
=IF(A1>60,25,IF(A1>30,10,0)) وهي تحتوي على معادلتين اف متداخلتين
بالتوفيق 

الكود ليس به اي عناصر غير userform2 & listbox1
لذا انصح بعمل compile من قائمة debug

ساعتها يظهر المشكلات في المشروع كله

جرب استعمال هذه المعادلة في الخلية F1
=CONCATENATE(A1,B1,C1,D1,TEXT(E1,"yyyy/mm/dd")) بالتوفيق 

لن تجد ما يحقق غرضك مائة بالمائة 
ولكن يمكنك تطويع الفكرة لما يناسب ملفك 
لتحويل المعادلة الى كود يمكنك استعمال هذا الإجراء 
ويمكنك تغيير النطاق E3 كما تشاء
 
With Range("e3") .Formula = "put your formula here" .Value = .Value End With التوفيق 

إن شاء الله يفيدك هذا التعديل
تم وضع معادلا للجمع
وشروط لاختبار الاجمالي مع المساحة
ملف فارغ لحساب - حصر المزروعات - للرفع.xls

هل ما تذكره بعد التجربة ام مجرد تخمين ؟
على العموم جرب هذا التعديل
If Me.ComboBox2.Value = cstr(ws.Cells(i, "AH").value) Then بالتوفيق 

حسب فهمي للصورة النهائية للمطلوب
تفضل هذه أكواد استيراد واستعراض وتصدير 
Private Sub estrad_Click() If IsNull(Me.FilePath.Value) Then MsgBox "يجب تحديد مسار الملف اولاً", vbCritical + vbMsgBoxRight, "تنبيه" Else Dim ImpEX As String Dim strSQL As String ' حذف محتويات الجدول strSQL = "DELETE tbl1.* FROM tbl_Items;" DoCmd.SetWarnings False DoCmd.RunSQL strSQL DoCmd.SetWarnings True ' استيراد جدول الإكسل إلى جدول الأكسس المطلوب ImpEX = Me.FilePath.Value DoCmd.TransferSpreadsheet acImport, 8, "tbl_Items", ImpEX, True Me.Requery MsgBox "أكسس استورد البيانات المطلوبة من ملف إكسل بنجاح" End If End Sub Private Sub FileDialog_Click() With Application.FileDialog(3) .Title = "اختر ملفا لاستيراده" .Filters.Clear .Filters.Add "Excel 2007", "*.xlsx" .Filters.Add "Excel 2003", "*.xls" .AllowMultiSelect = False .InitialFileName = "" If .Show = True Then Me.FilePath.Value = .SelectedItems(1) Else MsgBox "تم إلغاء الإجراء." End If End With End Sub Private Sub tasder_Click() On Error GoTo err: DoCmd.OutputTo acOutputTable, "tbl_Items", acFormatXLSX, , False MsgBox "أكسس صدر البيانات المطلوبة إلى ملف إكسل بنجاح" Exit Sub err: MsgBox "مشكلة بتصدير الملف" End Sub بالتوفيق 

جرب هذا الاختصار 
Dim str As String searchtext.SetFocus str = Me.searchtext.Text str = Replace(str, "أ", "ا") str = Replace(str, "إ", "ا") str = Replace(str, "آ", "ا") str = Replace(str, "ة", "ه") str = Replace(str, "ى", "ي") Me.searchtext = Replace(str, "ؤ", "و") بالتوفيق 

تفضل أخي الكريم 
يمكنك استخدام دالة معرفة udf لجلب معيار او معيارين للفلتر في الخلية وتكون فارغة في حالة عدم تشغيل الفلتر 
Function AutoFilter_Criteria(Rng As Range) As String Dim str1 As String, str2 As String Application.Volatile With Rng.Parent.AutoFilter With .Filters(Rng.Column - .Range.Column + 1) If Not .On Then Exit Function str1 = CStr(.Criteria1) If .Operator = xlAnd Then str2 = " AND " & CStr(.Criteria2) ElseIf .Operator = xlOr Then str2 = " OR " & CStr(.Criteria2) End If End With End With AutoFilter_Criteria = Replace(UCase(Rng) & ": " & str1 & str2, "=", "") End Function ولاستدعائها
=AutoFilter_Criteria(C7) بالتوفيق 

يا أخي الكريم
كل هذا افتراض منا لأنك لم ترفع ملفا أو تحدد ما تحتاجه تمام التحديد
من يعرف أساسيات البرمجة ب vba يعرف أنه يمكنك تحديد أي عدد من الأعمدة بكتابته بدلا من 10
ويعرف أيضا أنه لإخفاء الصفوف نغير كلمة columns إلى rows
ويعرف أيضا أن cells تحتاج إلى رقم الصف ثم رقم العمود وتغيير مكان العداد n هو الذي يحدد اتجاه الإخفاء
فلو كانت n في الرقم الثاني قهي تمثل العمود وإذا وضعتها في الرقم الأول فهي تمثل الصف
وهذا الكود ربما يفيدك
Sub hideblank() For n = 1 To 10 If Cells(1, n) = "" Then Columns(n).Hidden = True Next n For n = 1 To 10 If Cells(n, 1) = "" Then Rows(n).Hidden = True Next n End Sub Sub showblank() Columns("a:j").Hidden = False Rows("1:10").Hidden = False End Sub أرجو أن يكون الأمر قد اتضح
وفي الأخير أرجو من الله أن يتقبل تطوعي هذا في حل مشكلات الآخرين سواء قدروا أو لم يقدروا

يا أخي الكريم
كل هذا افتراض منا لأنك لم ترفع ملفا أو تحدد ما تحتاجه تمام التحديد
من يعرف أساسيات البرمجة ب vba يعرف أنه يمكنك تحديد أي عدد من الأعمدة بكتابته بدلا من 10
ويعرف أيضا أنه لإخفاء الصفوف نغير كلمة columns إلى rows
ويعرف أيضا أن cells تحتاج إلى رقم الصف ثم رقم العمود وتغيير مكان العداد n هو الذي يحدد اتجاه الإخفاء
فلو كانت n في الرقم الثاني قهي تمثل العمود وإذا وضعتها في الرقم الأول فهي تمثل الصف
وهذا الكود ربما يفيدك
Sub hideblank() For n = 1 To 10 If Cells(1, n) = "" Then Columns(n).Hidden = True Next n For n = 1 To 10 If Cells(n, 1) = "" Then Rows(n).Hidden = True Next n End Sub Sub showblank() Columns("a:j").Hidden = False Rows("1:10").Hidden = False End Sub أرجو أن يكون الأمر قد اتضح
وفي الأخير أرجو من الله أن يتقبل تطوعي هذا في حل مشكلات الآخرين سواء قدروا أو لم يقدروا

يا أخي الكريم
كل هذا افتراض منا لأنك لم ترفع ملفا أو تحدد ما تحتاجه تمام التحديد
من يعرف أساسيات البرمجة ب vba يعرف أنه يمكنك تحديد أي عدد من الأعمدة بكتابته بدلا من 10
ويعرف أيضا أنه لإخفاء الصفوف نغير كلمة columns إلى rows
ويعرف أيضا أن cells تحتاج إلى رقم الصف ثم رقم العمود وتغيير مكان العداد n هو الذي يحدد اتجاه الإخفاء
فلو كانت n في الرقم الثاني قهي تمثل العمود وإذا وضعتها في الرقم الأول فهي تمثل الصف
وهذا الكود ربما يفيدك
Sub hideblank() For n = 1 To 10 If Cells(1, n) = "" Then Columns(n).Hidden = True Next n For n = 1 To 10 If Cells(n, 1) = "" Then Rows(n).Hidden = True Next n End Sub Sub showblank() Columns("a:j").Hidden = False Rows("1:10").Hidden = False End Sub أرجو أن يكون الأمر قد اتضح
وفي الأخير أرجو من الله أن يتقبل تطوعي هذا في حل مشكلات الآخرين سواء قدروا أو لم يقدروا

إذا قمت بتسجيل ماكرو 
وقمت بحفظ ورقة العمل إلى pdf
ستحصل على الكود
بالتوفيق 

أولا أنصح بالتحول إلى إصدار أوفيس أعلى من 2003
تم تغيير امتداد الملف لتعمل دالة iferror
تم الحساب على تاريخ نهاية الاستحقاق R7
بالتوفيق 
بيان اجارات الشركة.xlsx

رائع جدا تطبيقك للفكرة
ويمكنك استعمال هذا الكود فقط في النموذج
Private Sub UserForm_Activate() minutes = 0.1 For a = 1 To 100 timer_avant = Timer Do While Timer < timer_avant + minutes DoEvents Me.Im1.Width = a * 474 / 100 Me.Nour1.Caption = a Loop Next Me.Hide End Sub لاحظ التغيير في عرض التسمية im1.width
حيث 474 هو العرض الأساسي للتسمية
ونحن قسمنا 474 على 100 ثم ضربنا في a لنحصل على العرض الكامل في نهاية العداد a
بالتوفيق 

يمكنك استعمال هذا الشرط
ضع في المصفوفة shArr اسماء الشيتات التي ترغب البحث فيها
وغير كود for each x الى 
shArr = array("sheet1","sheet2","sheet3") For Each x In ThisWorkbook.Worksheets if UBound(Filter(shArr, x.name)) > -1 then ss = x.Cells(Rows.Count, 2).End(xlUp).Row For Each C In x.Range("c3:c" & ss) b = InStr(C, TextBox19) If b > 0 Then ListBox1.AddItem ListBox1.List(k, 0) = x.Cells(C.Row, 1).Value ListBox1.List(k, 1) = x.Cells(C.Row, 2).Value ListBox1.List(k, 2) = x.Cells(C.Row, 3).Value ListBox1.List(k, 3) = x.Cells(C.Row, 4).Value ListBox1.List(k, 4) = x.Cells(C.Row, 5).Value ListBox1.List(k, 5) = x.Cells(C.Row, 6).Value ListBox1.List(k, 6) = x.Cells(C.Row, 7).Value ListBox1.List(k, 7) = x.Cells(C.Row, 8).Value ListBox1.List(k, 8) = x.Cells(C.Row, 9).Value ListBox1.List(k, 9) = x.Cells(C.Row, 10).Value ListBox1.List(k, 10) = x.Cells(C.Row, 11).Value ListBox1.List(k, 11) = x.Cells(C.Row, 12).Value ListBox1.List(k, 12) = x.Cells(C.Row, 13).Value ListBox1.List(k, 13) = x.Cells(C.Row, 14).Value ListBox1.List(k, 14) = x.Cells(C.Row, 15).Value ListBox1.List(k, 15) = x.Cells(C.Row, 16).Value ListBox1.List(k, 16) = x.Cells(C.Row, 17).Value ListBox1.List(k, 17) = x.Cells(C.Row, 18).Value k = k + 1 End If Next C end if Next x بالتوفيق 

هذه بعض نتائج البحث في المنتدى 
https://www.officena.net/ib/search/?q=سداد القروض&updated_after=any&sortby=relevancy&search_and_or=and
بالتوفيق 

لتحويل المعادلة الى كود يمكنك استعمال هذا الإجراء 
With Range("e3") .Formula = "put your formula here" .Value = .Value End With ويمكنك تغيير النطاق كما تشاء
بالتوفيق 

البرنامج يعمل بكفاءة ولا يحتاج إلى شيء
وبالنسبة لموضوع التعديل فيمكنك استئذان صاحب الكود في الاطلاع على الملف وإعطائك كلمة مرور الفيجوال بيسك
بالتوفيق

لمنع تعديل الصور
في نافذة حماية الشيت protect sheet
قم بإلغاء تنشيط edit objects