عبدالله بشير عبدالله

تم التعديل 
استمارة الكترونية1.xlsm

وعليكم السلام ورحمة الله وبركاته
تم تعديل المعادلات ليكون ارتباطها بالخلية N9 فقط في صفحة استدعاء ومن ضمنها الاعمدة المخفية  D & K  مع تعديل طفيف بالكود
bac test1.xlsm
 
 
 
 

وعليكم السلام ورحمة الله وبركاته
جرب الكود  وان كان يحتاج الى تعديل اعلمنى بالامر
__نسخة aaaa_.xlsb

عذرا طلبك واضح ولكنى لم انتبه
عن طريق كود 
 
كتابة اسماء الفصول بالارقام العربية.xlsb

وعليكم السلام ورحمة الله وبركاته 
اليك الملف واستبدله  في مجلد جمع الفواتير
الكود يتعامل مع اي عدد من الملفات  امتدادها XLSM  حسب ملفاتك المرفقه ويمكن تعديلها بالكود ان نغير الامنداد
جرب الملف واعلمنى بالنتائج
جمع.xlsm
 

وعليكم السلام ورحمة الله وبركاته
جرب التعديل التالي  في الخلايا الصفراء
تعديل كود تنقيط.xlsm

وعليكم السلام ورحمة الله وبركاته
استخدم هذه المعادلة  بدون تقريب الرقم، مع عرض منزل عشرية واحدة فقط إذا وُجدت، ولا يتم عرض .0 إذا كان العدد صحيحًا
 
=IF(D2=INT(D2); D2; INT(D2*10)/10) مثال للتوضيح
العدد العشري.xlsx

وعليكم السلام ورحمة الله وبركاته
نم  النظر في  جميع الملاحظات وتم التعديل ان شاء الله
مع ملاحظة اعادة  معادلة الترقيم في شيت معاشات كنت جعلت الترقيم تلقائى لجعل الكود اسرع 
قحسب طلبك العدد سيكون اكثر من 10000  ومن اسباب ثقل الاكواد المعادلات 
وخاصة ان شيت DATA  سيكون به اكثر من 70000 معادلة اذا كان عدد الموظفين اكثر من 10000
وعلى كل حال مواصفات الجهاز الجيدة لها دور كبير في سرعة معالجة البياتان
اتمنى ان تجد طلبك في الملف ولا حرج في اي ملاحظات تراها تخدم العمل في ملفك
حفظك الله برعايته ورزقك من ثمار الجنة
ترحيل بيانات الموظف المحال للمعاش إلى شيت آخر وحذفه من قاعدة البيانات 5.xlsb
 

السلام عليكم
ساشرح لك بمثال 
لنفرض ان الملف 1 به الكود الثالي
Sub SortData() Dim ws As Worksheet Set ws = ThisWorkbook.Sheets("ورقة1") With ws.Sort .SortFields.Clear .SortFields.Add Key:=ws.Range("I8:I73"), Order:=xlDescending .SetRange ws.Range("A8:AH73") .Header = xlNo .Apply End With End Sub وتريد تقل الكود الى الملف  2 حيث تريد عمود الفرز مثلا العمود  M واول صف به بيانات هو الصف 10 واخر صف به بيانات هو الصف 120 واول عمود به بيانات  B واخر عمود به بيانات هو العمود  BA
الخطوات :-
تعديل الكود ليتناسب مع التغيرات في الملف 2
السطر في الكود             .SortFields.Add Key:=ws.Range("I8:I73"), Order:=xlDescending
السطر السابق خاص بالعمود المطلوب فرزه  I8  تعنى  بداية فرز البيانات  الصف 8 للعمود  I    تهاية الفرز لتفس العمود الصف 73
الان تريد ان تعدل في السطر حسب الملف2 
الملف 2   المطلوب عمود الفرز M واول صف به بيانات هو الصف 10    فتكتب بدل  M10  -I8  واخر صف 120 فنستبدل  M120 - I73  فيكون السطر النهائي
             .SortFields.Add Key:=ws.Range("M10:M120"), Order:=xlDescending
وكذلك يتم التغيير في السطر
 
        .SetRange ws.Range("A8:AH73")                 هذا النطاق يحتوي على جميع الخلايا من العمود A إلى AH ومن الصف 8 إلى 73.
,والملف 2  الخلايا  من العمود Bإلى BAومن الصف 10إلى 120.
فيصبح     SetRange ws.Range("B10:BA120")      
فيصبح الكود النهائي
Sub SortData() Dim ws As Worksheet Set ws = ThisWorkbook.Sheets("ورقة1") With ws.Sort .SortFields.Clear .SortFields.Add Key:=ws.Range("M10:M120"), Order:=xlDescending .SetRange ws.Range("B10:BA120") .Header = xlNo .Apply End With End Sub   بالتوفيق

السلام عليكم 
جرب التعديل في الملف
Option Explicit Sub CircleLowGrades() Dim ws As Worksheet Dim gradeRanges As Variant Dim maxRanges As Variant Dim cell As Range Dim maxCell As Range Dim maxGrade As Double Dim shp As Shape Dim i As Integer, j As Integer Dim gradeRange As Range, maxRange As Range Set ws = ThisWorkbook.Sheets("شهادةنصف") gradeRanges = Array(ws.Range("D13:P13"), ws.Range("D30:P30"), ws.Range("D47:P47")) maxRanges = Array(ws.Range("D12:P12"), ws.Range("D29:P29"), ws.Range("D46:P46")) For Each shp In ws.Shapes If shp.Name Like "Circle*" Then shp.delete Next shp For i = LBound(gradeRanges) To UBound(gradeRanges) Set gradeRange = gradeRanges(i) Set maxRange = maxRanges(i) For j = 1 To gradeRange.Cells.Count Set cell = gradeRange.Cells(j) Set maxCell = maxRange.Cells(j) If IsNumeric(maxCell.Value) Then maxGrade = Val(maxCell.Value) Else maxGrade = 0 End If If IsNumeric(cell.Value) Then If Val(cell.Value) < maxGrade Then Call DrawCircle(ws, cell) End If ElseIf cell.Value = "غ" Or cell.Value = "غـ" Or cell.Value = "صفر" Then Call DrawCircle(ws, cell) End If Next j Next i End Sub Sub DrawCircle(ws As Worksheet, cell As Range) Dim shp As Shape Set shp = ws.Shapes.AddShape(msoShapeOval, cell.Left + 2, cell.Top + 2, cell.Width - 4, cell.Height - 4) shp.Name = "Circle" & cell.Address(False, False) shp.Line.ForeColor.RGB = RGB(255, 0, 0) shp.Fill.ForeColor.RGB = RGB(255, 255, 255) shp.Fill.Transparency = 1 End Sub test1.xlsb

، الصورة التي أرفقتها تُظهر 4 أزرار في مربع الحوار، وهو شيء غير ممكن عند استخدام MsgBox مباشرة في VBA، حيث يدعم MsgBox فقط حتى 3 أزرار كحد أقصى.

السلام عليكم
اوافق  استاذتا ابو عيد  على ما تفضل به
ولكن احيانا لائحة الدراسة والامتحانات تنص على هذه الطريقة
على كل حال
من اكواد وكنوز المنتدى  فيه طلبك ان شاء الله
ترتيب التلاميذ تصاعديا (1).xlsm
 

السلام عليكم
جزاك الله خيرا على دعائك
جرب التعديل في المرفق
وان لم يكن الامر هو المطلوب فاعذرنى 
قال توقف تفكيري وتركيزي
ياريته معاي توقف وبس
مش لاقيه خالص
تحياتي
sample.xlsb (1) (1).xlsm
 

يالرغم اننا لا نعلم اصدار الاكسل لديك ولكن الملف المرفق  به كود للاصدار القديم 2003  فنا فوق وتم حفظه  شيت .xls لينعامل مع الاصدار 2003
فكرة الكود
الكود  اذا كانت L6 و N6 فارغتان ينم طباعة كل الاستمارات
اذا تم تحديد الخليتين  مدى معين لعدد معين من الطلبة يتم طباعة المحدد فقط
مع عدم المساس بالمعادلات الموجودة بلالاستمارة
اعلمنى بالنتائج بعد التجربة 
شيت نتيجة.xls

السلام عليكم 
جرب الملف
تعديل كود.xlsm

وعليكم السلام ورحمة الله وبركاته
الكود 
Sub تجميع_البيانات() Dim wsSummary As Worksheet Dim ws As Worksheet Dim lastRow As Long Dim summaryLastRow As Long Dim dataRange As Range On Error Resume Next Set wsSummary = ThisWorkbook.Sheets("ملخص") On Error GoTo 0 If wsSummary Is Nothing Then Set wsSummary = ThisWorkbook.Sheets.Add wsSummary.Name = "ملخص" End If wsSummary.Rows("3:" & wsSummary.Rows.Count).ClearContents summaryLastRow = 3 For Each ws In ThisWorkbook.Sheets If ws.Name <> wsSummary.Name Then lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row If lastRow >= 3 Then Set dataRange = ws.Range("A3:Q" & lastRow) wsSummary.Cells(summaryLastRow, "A").Resize(dataRange.Rows.Count, dataRange.Columns.Count).Value = dataRange.Value summaryLastRow = summaryLastRow + dataRange.Rows.Count End If End If Next ws MsgBox "تم تجميع البيانات !", vbInformation End Sub الملف 
Book1.xlsb
 

وعليكم السلام ورحمة الله وبركاته
حسب فهمى لطلبك اليك الملف
مثال (1).xlsm
 

السيد  Khorsheed Omar
المعادلة
=IF([@[الاسم الثلاثي]]<>""; VLOOKUP([@[الاسم الثلاثي]]; 'البيانات الأساسية'!$A$2:$R$100;MATCH("2.2025"; 'البيانات الأساسية'!$1:$1; 0); FALSE); "") 1رواتب.xlsm

وعليكم السلام ورحمة الله وبركاته
طريقتان واختاري ما يتاسبك
الاولى ان يكون الملفان مفتوحان في نفس الوقت ونفس المجلد وبنفس الاسم   تحديث عدد الطلاب2 ( يمكن تعديله من الكود) 
ملف الطلاب الاصل.xlsb
الثانية الملف مقفول وبأي اسم بمعنى عند الضغط على زر تحديث البيانات تظهر واجهة نخنار الملف المراد اخد البيانات منه
ملف الطلاب الاصل2.xlsb
اتمنى ان يكون طلبك في احد الملفين
لك كل التقدير والاحترام

اخي العزيز
إضافة العمود المساعد  لتحسين قابلية التعامل مع البيانات باستخدام المعادلات العادية (بدلاً من الصفيفية). 
عندما نريد تصفية البيانات (مثل ملفك)، يمكننا استخدام معادلات مثل INDEX وMATCH لتحديد الصفوف المطلوبة. ومع ذلك، هذه المعادلات تحتاج إلى طريقة لمعرفة الصفوف التي تحقق الشرط.
العمود المساعد يعمل كـ "علامة" تحدد الصفوف التي تحقق الشرط (J9 < D2) وتُظهر رقم الصف الخاص بها. وإذا لم يتحقق الشرط، يُظهر العمود قيمة فارغة ("") القيم الموجودة في العمود X  هي رقم الصف الذي ينحقق به الشرط في D2 طبعا يمكن الاستغناء على العمود المساعد باستخدام معادلات صفيفية أو حلول برمجية (مثل VBA) والعمود المساعديساعد على تحسين الأداء في النسخ القديمة من Excel مثل 2010 النسخ الحديثة 2019 وما فوق يمكن استخذام دالة FILTER وحقيقة انا لا املك في جهازي الا اصدار 2016 فلا يمكننى التجربة واخير يبقى الكود افضل مم سبق دكره واسرع ويمكن ان يكون تلقائيا بدون زر اليك ملف به  حلات اخران الاول بمعادلات عادية بدون عمود مساعد والاخ على اليسار بالمعادلات الصفيفية 1شيت.xlsx  حل اخر ويعنبر افضلهم بدون معادلات وبدون زر .عند الكنابة في D2 تتم الفلترة للدرجات ولا تنسى تمكين الماكرو شيت1.xlsb اتمنى  فيما دكر بعض الفائدة نحياتي

السلام عليكم
dashboared موضوع يحناج الى من يتقن اعداد الجدوال بالاكسل   مثل جدول الموظفات الجدد في صفحة  وجدول المواضيع في صفحة وجدول الاجتماعات في صفحة
واستخدام معادلة COUNTIF لحساب عدد الموظفات وعدد المواضيع المفعلة وغيرها
ثم بانشاء صفحة داش بورد والتي تتطلب منك 
اتقان الرسوم البيانية   والجداول المحورية  والتي يكون مصدر بياناتها   الصفحات الاخري 
عند النغيير في اي بيان في الصفحات يتم تغييره تلقائيا في الرسوم البيانية والجداول المحورية
ابحثى في اليوتيوب به الكثير من الدروس  هذا احداها
 
 
اليك ملف يمكنك التعديل عليه
dashboared.xlsx
 

السلام عليكم
قم بتفعيل الماكرو
الكود
Private Sub Worksheet_Change(ByVal Target As Range) If Target.Address = "$G$2" Then Dim wsReport As Worksheet Dim wsSearch As Worksheet Dim lastRow As Long Dim i As Long Dim searchDate As Date Set wsReport = ThisWorkbook.Sheets("REPORT") Set wsSearch = ThisWorkbook.Sheets("Search2") searchDate = wsSearch.Range("G2").Value wsSearch.Range("B4:G1000").ClearContents lastRow = wsReport.Cells(wsReport.Rows.Count, "D").End(xlUp).Row Dim rowIndex As Long rowIndex = 4 For i = 2 To lastRow If wsReport.Cells(i, "D").Value = searchDate Then wsSearch.Cells(rowIndex, "B").Value = rowIndex - 3 wsSearch.Cells(rowIndex, "C").Value = wsReport.Cells(i, "G").Value wsSearch.Cells(rowIndex, "F").Value = wsReport.Cells(i, "J").Value wsSearch.Cells(rowIndex, "D").Value = wsReport.Cells(i, "I").Value wsSearch.Cells(rowIndex, "E").Value = wsReport.Cells(i, "H").Value rowIndex = rowIndex + 1 End If Next i End If End Sub New Microsoft Excel Worksheet (1).xlsb

السلام عليكم 
الحمد لله تم اصلاح العطل بالمنتدى
 
بواسطة  فلترة البيانات بالعمود الاول A يمكن تعديل حسب العمود الذي به بيانات في الجزء 
Field:=1 الكود 
 
Sub SaveRangeAsPDF() Dim ws As Worksheet Dim savePath As String Set ws = ThisWorkbook.Sheets("ورقة1") With ws .Range("A1:Z999").AutoFilter Field:=1, Criteria1:="<>" savePath = "D:\" & .Range("AA1").Value & " " & Format(Now, "yyyy-mm-dd,hh.mm") & ".pdf" .Range("A1:Z999").ExportAsFixedFormat Type:=xlTypePDF, Filename:=savePath, _ Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False .AutoFilterMode = False End With MsgBox "تم حفظ الملف بنجاح!", vbInformation, "حفظ PDF" End Sub الملف 
DFP2.xlsb

السلام عليكم
دالة countif مضافاً إليها دالة max  ضعها في a2 ثم اسحبها للاسفل
=IF(COUNTIF($B$2:B2; B2)=1; MAX($A$1:A1)+1; "") ملف
ترقيم بتجاوز المكرر.xlsx

وعليكم السلام ورحمة الله وبركاته
="D:\الهويات\Pictures\" & ROW(A1) & ".jpg" ثم لسحب للاسفل
ويمكنك نسخها ولصقها كقيم يعد ذلك
New Microsoft Excel Worksheet.xlsx