حسين مامون

عليكم السلام جرب كما في الصورة

وعليكم السلام انسخ الماكرو الى محرر الاكواد واحفظ الملف بصيغة xlsm ثم جرب Sub copy_tous() Dim ws As Worksheet Dim Aws As Worksheet Dim lr Set ws = Sheets("Data") Set Aws = ActiveSheet lr = ws.Cells(Rows.Count, 1).End(3).Row ws.Range("a2:ar" & lr).Copy Aws.Range("a2") msgbox"تم النسخ بنجاح" End Sub

اخي قلت ليست لي فكرة عن هذا يعني عن برمجتها

ليست لي فكرة عن هذا ولم اجد في الفورم اي اداة اخرى غير Textbox و label

تفضل جرب قمت باضافة listbox لعرض محتوى الصفحة جرب.xlsm

جواب على قد سؤالك هو هذا Private Sub TextBox2_Change() If TextBox2 > 0 Then TextBox3.Value = Val(TextBox1) End If End Sub

انظر المرفق test2022.xlsx

ربما قرعة(3).xlsm

اخي الكريم تشكر يجب توضيح المشكل الذي واجهته مع الكود لتلقي المساعدة من احد الاخوة وتفادي هدر وقتك ووقت الاخرون جرب المرفق ملف طلب المساعدة (1).xlsm

جرب هذا الماكرو فيه حلقة تكرارية تفحص التاريخ في العمود F ويدرج COMMANT قبل عشرة ايام Sub test() 'On Error Resume Next Dim lr Dim x Dim dt: dt = Date Dim dt2: dt2 = Format(DateAdd("d", -10, dt), "dd-mm-yyyy") With Sheets("نشاط") lr = .Cells(Rows.Count, "f").End(xlUp).Row .Range("f3:f" & lr).ClearComments For x = 3 To lr If Not IsDate(.Cells(x, "f")) = True Then GoTo 1 If CDate(Cells(x, "f")) = dt2 Then .Cells(x, "f").AddComment .Cells(x, "f").Comment.Visible = True .Cells(x, "f").Comment.Text Text:=":" & Chr(10) & "عشرة ايام متبقية " End If 1: Next x End With End Sub

تفضل ترحيل بيانات.xlsm

اليك ما تريد في هذه المشاركة

نعم تم التعديل الكود الان يقوم بالغاء اي الوان في الجدول و يلون السطر المعني فقط

الكود شغال 100/100 بس فيه شرط لي هو ينفذ الامر في اليوم 14 في الشهر انظر الصورة لتجربة الكود اكتب رقم 8 عوض 14

كان طلبك تنسيق الارقام ولكن هناك مشاركة ربما فيها ما تريد https://www.officena.net/ib/applications/core/interface/file/attachment.php?id=214255&key=963ce63aa311dfeead73411430b422e6