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

السلام عليكم حسب التجربة الكود يعمل جيدا ولا يحتاج الى تعديل ويعطى نتائج كما في طلبك شاهد المرفق بعد حذف ارتباط ملفك بملفات اخرى 1تفقيط الرقم.xlsm وان كنت تقصد شئ اخر فاوضح اكثر كما لا تتسى ان تنقدم بالشكر لصاحب الكود معلمتا الاستاذ عبدالله باقشير من اليمن السعيد صاحب المساهمات القيمة في تطوير أدوات Excel باستخدام VBA، حيث قام بإنشاء العديد من النماذج والملفات التي تساعد المستخدمين في تنفيذ مهامهم بشكل أكثر كفاءة فجزاه الله كل خير وجعل ما قدمه في موازيين حسناته

وعليكم السلام ورحمة الله وبركاته الطريفة الاولى قبل حفظ الملف ارجع الى الصفحة الرئيسية ثم حفظ الطريقة الثاتية عن طريق كود وسيقوم بفتح الصفحة الرئيسية حتى لو قمت بالحفظ عند ورقة 10 مثلا ضع هذا الكود في محرر الاكود في ThisWorkbook Private Sub Workbook_Open() Sheets("SHEET1").Activate End Sub طبعا غير اسم SHEET1 بالكود باسم الشيت الرئيسى لديك

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

وعليكم السلام ورحمة الله وبركاته عذرا الملف لا يوجد به اي كود وهو مرتبط بملف اخر موجود على جهازك

ما شاء الله ايداع جزاك الله خيرا

الملف في الرد السابق

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

وعليكم السلام ورحمة الله وبركاته ارفق ملفك وابشر خيرا

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

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

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

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

وعليكم السلام ورحمة الله وبركاته طلبك كبير ومهم جدًا لأي شخص يتعلم VBA في Excel. ارجو تحديد الاوامر المطلوب شرحها لان كل امر يحناج الى وقت لشرحه ويمكنك البحث في اليوتيوب تجد شروح عديدة ومفيدة في VBA – هناك فئات كثيرة من الأوامر: اهمها 🔹 1. التعامل مع الخلايا (Cells / Range) قراءة البيانات من خلايا متعددة - تغيير قيم مجموعة من الخلايا- التعامل مع نطاقات خلايا أكبر 🔹 2. التعامل مع الصفوف والأعمدة 🔹 3. التعامل مع الأوراق (Sheets) 🔹 4. التعامل مع المصنفات (Workbooks) 🔹 5. التعامل مع النصوص (Strings) 🔹 6. الرسائل (MsgBox و InputBox) إظهار رسالة تنبيه للمستخدم - استخدام InputBox للحصول على إدخال من المستخدم 🔹 7. التعامل مع البيانات (Data Manipulation) 🔹 8. التكرار (Loops) استخدام For Each للتكرار عبر مجموعة من الخلايا - استخدام حلقة For لتكرار الأوامر 🔹 9. المعاملات الشرطية (If و Select Case) استخدام If لتحديد شرط - استخدام Select Case بديلًا عن سلسلة If مع شروط متعددة 🔹 10. أوامر إيقاف الكود (Exit و End)

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

وعليكم السلام ورحمة الله وبركاته جزاك الله خيرا على دعاؤك الطيب لي واسأل الله ان يجازيك خير الجزاء تم تعديل الكود ليتعامل مع البيانات الكثيرة بالنسبة للاحصائيات جعلتها في اعلى الصفحة والكود يقوم بحسابها آليا - ووجودها اسفل الصفحة يعرقل عمل الكود وحاولت ولم اتوصل الى نتيحة مرضية (حسب علمي ) بالنسبة للنرنيب التصاعدي الكود يتعامل مع العمود L في شيت معاشات وجربنه ويعمل جيدا الملف المرفق به 7000 تقريبا صف طبعا قم بنجربة الترحيل ولاحظ الترتيب واي ملاحظات اذكرها وات شاء الله وبعونه تقوم بالواجب لك كل التقدير والاحترام ترحيل بيانات الموظف المحال للمعاش إلى شيت آخر وحذفه من قاعدة البيانات 3.xlsb

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

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

وعليكم السلام ورحمة الله وبركانه وكل العام والجميع بخير لكافة اعضاء المنتدى اعتقد طلبك معادلة جزئيًا نعم، ولكن حذف الصف الأصلي تلقائيًا من شيت data → هذا غير ممكن بالمعادلات (حسب علمي والله اعلم ) اما عن طريق الكود فممكن الملف المرفق به كود يعمل تلقائيا كلما وجد كلمة معاش في شيت data في العمود H يقوم بترحيلها تلقائيا الى شيت معاشات مع حذفها من الشيت الاصلى وكذلك الترتيب التلقائي والتسلسل التلقائي في العمود A جرب تغيير تاريخ ميلاد اي اسم ليحال على المعاش ولاحظ عمل الكود ترحيل بيانات الموظف المحال للمعاش إلى شيت آخر وحذفه من قاعدة البيانات.xlsb

السلام عليكم استبدل السطر .SortFields.Add Key:=ws.Range("I8:I73"), Order:=xlDescending بهذا السطر .SortFields.Add Key:=ws.Range("I8:I73"), Order:=xlAscending لاحظ الكلمة الاخيرة تغيرت طبعا هذا الترتيب للنطاق I8:I73 بالتوفيق

الاسهم في اتجاه واحد نفضل BIOCHEMICAL TEST1.xlsb

نعم صدقت وفاتنى ذلك تعديل الملف BIOCHEMICAL TEST1.xlsb

وعليكم السلام ورحمة الله وبركاته بعد ملاحظة الاستاذ ابو عارف تم نعديل الملف في مشاركتى التالية

السلام عليكم جرب التعديل في الملف 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 أزرار كحد أقصى.

استاذ ابو حمادة صندوق الاوامر في اكسل الافتراضيه لا تدعم اكثر من امرين الى 3 اوامر فقط وهي:- vbOKCancel (موافق - إلغاء) vbYesNoCancel (نعم - لا - إلغاء) vbAbortRetryIgnore (إيقاف - إعادة المحاولة - تجاهل) vbYesNo (نعم - لا) vbRetryCancel (إعادة المحاولة - إلغاء) إذا كنت بحاجة إلى أكثر من ثلاثة أزرار، يمكنك إنشاء UserForm يحتوي على أربعة أزرار او اكثر مخصصة لتنفيذ الأوامر التي تريدها. ويمكنك تسمية الازرار باي اسم شاهد الملف بواسطة UserForm اوامر userform.xlsb