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

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

عذرا طلبك واضح ولكنى لم انتبه عن طريق كود كتابة اسماء الفصول بالارقام العربية.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

يتغير اسم الكود في حالة وجود كود اخر بتفس الاسم وعدا ذلك يبقى بنفس الاسم

السلام عليكم ساشرح لك بمثال لنفرض ان الملف 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 بالتوفيق

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

جزاك الله خيرا استاذنا الفاضل ابو عيد

وعليكم السلام اخي الفاضل وجهت استفسارك لصاحب الكود (الذكاء) فاجابني لا، هذا الكود لا يؤثر على رسائل النظام الافتراضية في Excel، مثل رسالة حفظ التغييرات عند إغلاق الملف أو رسائل الخطأ التلقائية، لأنه يعمل فقط عند استدعاء MyMesg كيف يعمل الكود؟ عند استدعاء MyMesg، يقوم بإنشاء Hook (تعديل مؤقت) لتغيير أسماء الأزرار في رسالة واحدة فقط. بمجرد عرض الرسالة، يتم إلغاء التعديل فورًا (UnhookWindowsHookEx m_hHook). Excel سيستمر في استخدام رسائله الافتراضية دون تغيير. هل يؤثر على الرسائل الأخرى؟ 🔹 لا يؤثر على رسائل النظام الافتراضية (مثل حفظ، إغلاق، أو خطأ الصيغ). 🔹 يؤثر فقط على الرسائل التي يتم إنشاؤها باستخدام MyMesg. إذا كنت تريد تأثيرًا دائمًا؟ إذا كنت تريد تغيير أسماء الأزرار لجميع رسائل MsgBox في Excel، يمكن تعديل Application.OnKey أو استخدام VBA Add-In، لكن هذا سيؤثر على جميع الرسائل. انتهى جواب الذكاء الاصطناعي قمت بتجربة الملف الذي ارفقته لك سابفا عتدقفل الملف تظهر واجهة الاكسل العادية ولا اعلم سبب ظهور الواجهة مختلفة لديك اثمنى من الاعضاء تحميل الملف واعلامنا بشكل الواجهة عتد غلق الملف هل هي واجهة اكسل العادية ام لا