ياسر خليل أبو البراء

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

جرب أن تحفظ المصنف بصيغة Xlsm أو ارفق الملف لمعرفة سبب الخطأ الخطأ والله أعلم سببه أن الكود الخاص بك يتعدى عدد الأعمدة في ورقة العمل أو يقوم بإزاحة عمود في آخر الأعمدة به بيانات ..

جرب التعديل Sub Post() Dim LRMain As Long Dim LRWS As Long Dim WS As Worksheet Set WS = ActiveSheet Application.ScreenUpdating = False Range("B3:P10000").ClearContents For Each WS In ThisWorkbook.Worksheets If WS.Name <> Sheets("Sheet1").Name Then WS.Activate LRWS = WS.Range("B" & Rows.Count).End(xlUp).Row If IsEmpty(WS.Range("B5")) Then GoTo 1 Range("B5:P" & LRWS).Copy Sheets("Sheet1").Activate LRMain = Sheets("Sheet1").Range("B" & Rows.Count).End(xlUp).Row + 1 Sheets("Sheet1").Range("B" & LRMain).PasteSpecial xlPasteValues Application.CutCopyMode = False End If Selection.Offset(0, 15).Resize(1, 1).Value = WS.Range("B2").Value 1 Next WS Call AutoNumberEvaluate Sheets("Sheet1").Range("A1").Select Application.ScreenUpdating = True End Sub Sub AutoNumberEvaluate() Application.ScreenUpdating = False Dim LRC As Long LRC = Sheets("Sheet1").Range("B" & Rows.Count).End(xlUp).Row With Range("A3:A" & LRC) .ClearContents .Value = Evaluate("ROW(A1:A" & .Rows.Count & ")") End With Application.ScreenUpdating = True End Sub

بارك الله فيك يا ابن مصر تنسيقات في منتهى الروعة ..أهكذا اكتمل العمل أخي هشام؟؟ هل لديك أقوال أخرى غير الدعاء لابن مصر ولي؟!!

أخي الفاضل أعتذر إليك الوقت تأخر ولابد أن أنام الآن لأني عندي امتحانات بدري وشغل طول النهار إن شاء الله تجد من يساعدك في إتمام المطلوب أستودعك الله

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

أخي الفاضل جرب الملف التالي Post All Sheets.rar

دايما سابقني يا ابن مصر ..مقطع عليا كدا دايما.. فين كود النهاردة (هصدعك!!)

أخي الفاضل أرسل الملف نفسه وليس الكود فقط

جزيت خيراً يا ابن مصر بينما كتبت مشاركتك بحثت ووجدت الحل يمكن أن يكون بهذا الشكل ليعمل على32 بت أو 64 بت #If VBA7 Then Private Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As LongPtr Private Declare PtrSafe Function GetWindowLong Lib "user32" Alias "GetWindowLongPtrA" (ByVal hWnd As LongPtr, ByVal nIndex As Long) As LongPtr Private Declare PtrSafe Function SetWindowLong Lib "user32" Alias "SetWindowLongPtrA" ( ByVal hWnd As LongPtr, ByVal nIndex As Long, ByVal dwNewLong As LongPtr) As LongPtr Private Declare PtrSafe Function DrawMenuBar Lib "user32" (ByVal hWnd As LongPtr) As Long #Else Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long) As Long Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long Private Declare Function DrawMenuBar Lib "user32" (ByVal hWnd As Long) As Long #End If

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

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

أعتقد بسبب عملك على نسخة 64 بت ، ولا أدري كيفية التعامل مع نظام الـ 64 بت .. ربما تجد من يساعدك بالأمر تقبل تحياتي

أخي الحبيب ياسر لا حرمنا الله من إضافاتك .. قم بالبحث عن كلمة [صلاحية] في مكتبة الصرح ، ستجد كود مشابه عموماً تمت إضافة هذا الكود أيضاً لتنوع الأفكار بعض الشيء

أخي بالنسبة للصورة أيضا بها نفس الخاصية..

أخي الحبيب بالنسبة لطبك فهو في منتهى البساطة انقر على زر الأمر ومن نافذة الخصائص Properties قم بالبحث عن الخاصية ControlTipText واكتب في الحقل المجاور لها التلميح الذي تريده أن يظهر للمستخدم .. انتهى

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

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

بارك الله فيكم إخواني الكرام على كل ما تقدمونه من جديد ومفيد تسلم أياديكم

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

ارفق ملفك الذي به الخطأ لمراجعة المعادلة مرة أخرى

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

جرب المرفق التالي Conditional Formatting By Code.rar

تمت العملية بنجاح بعد تنصيب الأداة جزاكم الله خيراً أخي الحبيب ابن مصر وتمت الإضافة للمكتبة وهذا ما أخرني في الرد .. عملت كل الأكواد بنجاح بعد تنصيب الأداة مشكور على تعبك معايا تقبل تحياتي القلبية :fff:

للأسف لم تفلح المحاولة أيضاً يا ابن مصر