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

السلام عليكم هذا تطبيق قد ينفع معك المرفق 2003 2003بحث و شطب.rar

السلام عليكم هل تقصد هكذا المرفق 2010 Book10.rar

اخي الحبيب شوقي ربيع

التهنئة بترقية الاخ محمد أبو البراء الى عضو محترف

جزاكم الله خيراً

السلام عليكم جرب الكود التالي Sub kh_Sort_Delete() Dim Cel As Range Dim LR As Long, R As Long LR = Sheets("المدخلات").Range("a" & Rows.Count).End(xlUp).Row With Sheets("المدخلات").Range("A3:Y" & LR) .Sort .Columns(1), xlAscending For R = 1 To .Rows.Count If WorksheetFunction.CountIf(.Cells(1, "A").Resize(R), .Cells(R, "A")) > 1 Then If Cel Is Nothing Then Set Cel = .Cells(R, "A") Else Set Cel = Union(Cel, .Cells(R, "A")) End If Next End With If Not Cel Is Nothing Then Cel.EntireRow.Delete Set Cel = Nothing End Sub واشعرنا بانتيجة تحياتي

نعم سمي القائمة باسم معين وضع هذا الاسم في تعليق في راس العمود الذي تريد اظهار القائمة فيه

اخي الفاضل غالب اخي الفاضل ابو جيداء اخي الفاضل ربيع اخي الفاضل galal elgammal اخي الفاضل جلال محمد

السلام عليكم هذا ايضا بالكود Sub test() Dim r As Integer, rr As Integer For r = 1 To 300 Step 3 rr = rr + 1 Range("A" & r).Resize(3).Value = rr Next r End Sub تحياتي

السلام عليكم ( ضرورة كتابة عنوان واضح للموضوع يدل على محتواه ويعطي وصفاً مختصرا للسؤال.) لقد تم تعديل عنوان الموضوع فارجوا الانتباه لاحقا لهذه النقطة لكي لا يتعرض الموضوع للاغلاق قواعد المشاركة فى الموقع اضغط هنـــــــــامن فضلك لقراءة القواعد كاملة و بصفة خاصة نؤكدعلى ما يلي 1- يمنع منعا باتا نشر أية مواد تخالف حقوق الملكية الفكرية و يرجى الابلاغ عن المشاركات المخالفة من خلال زر تقرير اسفل المشاركة 2-يجب استخدام خاصيةالبحث قبل طرح السؤال توفيرا للوقت و الجهد. 3-ضرورة كتابة عنوان واضح للموضوع يدل على محتواه ويعطي وصفاً مختصرا للسؤال. 4-ممنوع منعا باتاً كتابة عناوين سينمائية مثل عاجل ، نداء الي فلان ، الي الخبراء ، طلب مساعدة ، أريد حلا..... 5-يمكن استعجال الرد باستخدام تعبير -للرفع- و غير مسموح بالالحاح او اللوم فجميع الاعضاء يشاركون تطوعا طبقا لسعة وقتهم. ومخالفة ذلك تعرض الموضوع للحذف

اخي الفاضل خالد الشاعر اخي الفاضل تومي محمد اخي الفاضل احمد ريان اخي الفاضل سعد عابد اخي الفاضل قصي اخي الفاضل صالح اخي الفاضل الشهابي اخي الفاضل خالد القدس

السلام عليكم ورحمة الله وبركاته اخي الحبيب حمادة عمر ............حفظكم الله واثابكم بدعائكم واعطاكم بمثله اضعاف مضاعفة تقبلوا تحياتي وشكري

السلام عليكم ورحمة الله وبركاته اخي الفاضل احمد فؤاد ............حفظكم الله تقبلوا تحياتي وشكري

السلام عليكم ورحمة الله وبركاته اخي الحبيب أبو محمد عباس ............حفظكم الله واثابكم بدعائكم واعطاكم بمثله اضعاف مضاعفة تقبلوا تحياتي وشكري

شكرا جزيلا في عندك شي ناقص من مكتبة الاكواد عادي ممكن تستغني عنه Private Sub UserForm_Initialize() Dim Zo% Dim ZH#, ZW#, AL#, AT#, AH#, AW# Dim FH!, FW! '''''''''''''''''''''' AH = Application.Height: AW = Application.Width AL = Application.Left: AT = Application.Top FH = Height: FW = Width ZH = AH - FH: ZW = AW - FW: Zo = Zoom If ZH < ZW Then Zo = Zo * (AH / FH) Else If ZW < ZH Then Zo = Zo * (AW / FW) '''''''''''''''''''''' Move AL, AT, AW, AH If Zo <> 100 Then Zoom = Zo End Sub تحياتي

جزاكم الله خيرا

اخي الفاضل عادل ابوزيد اخي الفاضل احمد غانم اخي الحبيب ابو حنين

السلام عليكم جرب هذا Private Sub Worksheet_Change(ByVal Target As Range) On Error Resume Next If Not Intersect(Target, Range("a2:a50000")) Is Nothing Then sum1 = 0 Target.Offset(0, 1).Value = 0 With Sheets("Sheet2") z = Application.CountA(.Range("j2:j5000")) For i = 2 To z + 2 If Target.Value = .Cells(i, 10).Value And .Cells(i, 13) = 5 Then sum1 = sum1 + .Cells(i, 12).Value Target.Offset(0, 1).Value = .Cells(i, 11).Value End If Next i End With Target.Offset(0, 2).Value = sum1 End If End Sub تحياتي

اخي الحبيب رجب جاويش

اخي الفاضل الجموعي

اخي الفاضل عمرو_

اخي الفاضل حسين شاكر

السلام عليكم ورحمة الله وبركاته الاصدار الرابع : فورم اضافة وبحث وتعديل مرن مع استعراض الصور (تحكم كامل بالصورة ) المرفق 2003 فورم ادخال و تعديل مرن مع الصور.rar http://www.officena.net/team/khboor/kh_image/p86.png هام جدا بتاريخ ( 14 / 6 / 2023 ) لكي يعمل الفورم جيدا بدون اخطاء لابد من عمل الاتي 1- UnRegister MSCOMCT2.OCX ازاله تسجيل الملف MSCOMCT2.OCX تشغيل الامر cmd كمسئول ثم كتابه الأمر التالي لو كان الويندوز ٦٤ بت regsvr32 /u C:\Windows\SysWOW64\MSCOMCT2.OCX او regsvr32 /u C:\Windows\System32\MSCOMCT2.OCX لو كان الويندوز ٣٢ ثم بفك الضغط عن الملف المرفق بأسم MSCOMCT2.OCX ونقوم بنسخه الي المسار التالي ويندوز٦٤ بت C:\Windows\SysWOW64 ويندوز ٣٢ بت C:\Windows\System32 2- Register MSCOMCT2.OCX ثم نقوم بعمل ريجستر للملف الذي نسخناه في الويندوز عن طريق هذا الأمر ويندوز ٦٤ regsvr32 C:\Windows\SysWOW64\MSCOMCT2.OCX ويندوز ٣٢ regsvr32 C:\Windows\Sys\MSCOMCT2.OCX MSCOMCT2.zip